PR#4549: make Filename.dirname/basename POSIX compliant
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11999 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
b932aaa4e6
commit
2c04ae521e
2
Changes
2
Changes
|
@ -38,7 +38,7 @@ Standard library:
|
|||
(PR#5437)
|
||||
|
||||
Bug Fixes:
|
||||
- PR#4549: Filename.dirname is not handling multiple / on Unix
|
||||
* PR#4549: Filename.dirname is not handling multiple / on Unix
|
||||
- PR#4869: rare collisions between assembly labels for code and data
|
||||
- PR#4880: "assert" constructs now show up in the exception stack backtrace
|
||||
- PR#5313: ocamlopt -g misses optimizations
|
||||
|
|
2
VERSION
2
VERSION
|
@ -1,4 +1,4 @@
|
|||
3.13.0+dev8 (2011-10-25)
|
||||
3.13.0+dev9 (2012-01-06)
|
||||
|
||||
# The version string is the first line of this file.
|
||||
# It must be in the format described in stdlib/sys.mli
|
||||
|
|
|
@ -25,30 +25,55 @@ let generic_quote quotequote s =
|
|||
Buffer.add_char b '\'';
|
||||
Buffer.contents b
|
||||
|
||||
let generic_basename rindex_dir_sep current_dir_name name =
|
||||
let raw_name =
|
||||
try
|
||||
let p = rindex_dir_sep name + 1 in
|
||||
String.sub name p (String.length name - p)
|
||||
with Not_found ->
|
||||
name
|
||||
(* This function implements the Open Group specification found here:
|
||||
[[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
|
||||
In step 1 of [[1]], we choose to return "." for empty input.
|
||||
(for compatibility with previous versions of OCaml)
|
||||
In step 2, we choose to process "//" normally.
|
||||
Step 6 is not implemented: we consider that the [suffix] operand is
|
||||
always absent. Suffixes are handled by [chop_suffix] and [chop_extension].
|
||||
*)
|
||||
let generic_basename is_dir_sep current_dir_name name =
|
||||
let rec find_end n =
|
||||
if n < 0 then String.sub name 0 1
|
||||
else if is_dir_sep name n then find_end (n - 1)
|
||||
else find_beg n (n + 1)
|
||||
and find_beg n p =
|
||||
if n < 0 then String.sub name 0 p
|
||||
else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
|
||||
else find_beg (n - 1) p
|
||||
in
|
||||
if raw_name = "" then current_dir_name else raw_name
|
||||
if name = ""
|
||||
then current_dir_name
|
||||
else find_end (String.length name - 1)
|
||||
|
||||
let generic_dirname rindex_dir_sep current_dir_name dir_sep name =
|
||||
try
|
||||
match rindex_dir_sep name with
|
||||
0 -> dir_sep
|
||||
| n -> String.sub name 0 n
|
||||
with Not_found ->
|
||||
current_dir_name
|
||||
(* This function implements the Open Group specification found here:
|
||||
[[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
|
||||
In step 6 of [[2]], we choose to process "//" normally.
|
||||
*)
|
||||
let generic_dirname is_dir_sep current_dir_name name =
|
||||
let rec trailing_sep n =
|
||||
if n < 0 then String.sub name 0 1
|
||||
else if is_dir_sep name n then trailing_sep (n - 1)
|
||||
else base n
|
||||
and base n =
|
||||
if n < 0 then current_dir_name
|
||||
else if is_dir_sep name n then intermediate_sep n
|
||||
else base (n - 1)
|
||||
and intermediate_sep n =
|
||||
if n < 0 then String.sub name 0 1
|
||||
else if is_dir_sep name n then intermediate_sep (n - 1)
|
||||
else String.sub name 0 (n + 1)
|
||||
in
|
||||
if name = ""
|
||||
then current_dir_name
|
||||
else trailing_sep (String.length name - 1)
|
||||
|
||||
module Unix = struct
|
||||
let current_dir_name = "."
|
||||
let parent_dir_name = ".."
|
||||
let dir_sep = "/"
|
||||
let is_dir_sep s i = s.[i] = '/'
|
||||
let rindex_dir_sep s = String.rindex s '/'
|
||||
let is_relative n = String.length n < 1 || n.[0] <> '/';;
|
||||
let is_implicit n =
|
||||
is_relative n
|
||||
|
@ -61,8 +86,8 @@ module Unix = struct
|
|||
let temp_dir_name =
|
||||
try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
|
||||
let quote = generic_quote "'\\''"
|
||||
let basename = generic_basename rindex_dir_sep current_dir_name
|
||||
let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
|
||||
let basename = generic_basename is_dir_sep current_dir_name
|
||||
let dirname = generic_dirname is_dir_sep current_dir_name
|
||||
end
|
||||
|
||||
module Win32 = struct
|
||||
|
@ -70,12 +95,6 @@ module Win32 = struct
|
|||
let parent_dir_name = ".."
|
||||
let dir_sep = "\\"
|
||||
let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
|
||||
let rindex_dir_sep s =
|
||||
let rec pos i =
|
||||
if i < 0 then raise Not_found
|
||||
else if is_dir_sep s i then i
|
||||
else pos (i - 1)
|
||||
in pos (String.length s - 1)
|
||||
let is_relative n =
|
||||
(String.length n < 1 || n.[0] <> '/')
|
||||
&& (String.length n < 1 || n.[0] <> '\\')
|
||||
|
@ -129,11 +148,11 @@ module Win32 = struct
|
|||
else ("", s)
|
||||
let dirname s =
|
||||
let (drive, path) = drive_and_path s in
|
||||
let dir = generic_dirname rindex_dir_sep current_dir_name dir_sep path in
|
||||
let dir = generic_dirname is_dir_sep current_dir_name path in
|
||||
drive ^ dir
|
||||
let basename s =
|
||||
let (drive, path) = drive_and_path s in
|
||||
generic_basename rindex_dir_sep current_dir_name path
|
||||
generic_basename is_dir_sep current_dir_name path
|
||||
end
|
||||
|
||||
module Cygwin = struct
|
||||
|
@ -141,33 +160,32 @@ module Cygwin = struct
|
|||
let parent_dir_name = ".."
|
||||
let dir_sep = "/"
|
||||
let is_dir_sep = Win32.is_dir_sep
|
||||
let rindex_dir_sep = Win32.rindex_dir_sep
|
||||
let is_relative = Win32.is_relative
|
||||
let is_implicit = Win32.is_implicit
|
||||
let check_suffix = Win32.check_suffix
|
||||
let temp_dir_name = Unix.temp_dir_name
|
||||
let quote = Unix.quote
|
||||
let basename = generic_basename rindex_dir_sep current_dir_name
|
||||
let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
|
||||
let basename = generic_basename is_dir_sep current_dir_name
|
||||
let dirname = generic_dirname is_dir_sep current_dir_name
|
||||
end
|
||||
|
||||
let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, rindex_dir_sep,
|
||||
let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
|
||||
is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
|
||||
dirname) =
|
||||
match Sys.os_type with
|
||||
"Unix" ->
|
||||
(Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
|
||||
Unix.is_dir_sep, Unix.rindex_dir_sep,
|
||||
Unix.is_dir_sep,
|
||||
Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
|
||||
Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
|
||||
| "Win32" ->
|
||||
(Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
|
||||
Win32.is_dir_sep, Win32.rindex_dir_sep,
|
||||
Win32.is_dir_sep,
|
||||
Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
|
||||
Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
|
||||
| "Cygwin" ->
|
||||
(Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
|
||||
Cygwin.is_dir_sep, Cygwin.rindex_dir_sep,
|
||||
Cygwin.is_dir_sep,
|
||||
Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
|
||||
Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
|
||||
| _ -> assert false
|
||||
|
|
|
@ -59,17 +59,19 @@ val chop_extension : string -> string
|
|||
|
||||
val basename : string -> string
|
||||
(** Split a file name into directory name / base file name.
|
||||
[concat (dirname name) (basename name)] returns a file name
|
||||
which is equivalent to [name]. Moreover, after setting the
|
||||
current directory to [dirname name] (with {!Sys.chdir}),
|
||||
If [name] is a valid file name, then [concat (dirname name) (basename name)]
|
||||
returns a file name which is equivalent to [name]. Moreover,
|
||||
after setting the current directory to [dirname name] (with {!Sys.chdir}),
|
||||
references to [basename name] (which is a relative file name)
|
||||
designate the same file as [name] before the call to {!Sys.chdir}.
|
||||
|
||||
The result is not specified if the argument is not a valid file name
|
||||
(for example, under Unix if there is a NUL character in the string). *)
|
||||
This function conforms to the specification of POSIX.1-2008 for the
|
||||
[basename] utility. *)
|
||||
|
||||
val dirname : string -> string
|
||||
(** See {!Filename.basename}. *)
|
||||
(** See {!Filename.basename}.
|
||||
This function conforms to the specification of POSIX.1-2008 for the
|
||||
[dirname] utility. *)
|
||||
|
||||
val temp_file : ?temp_dir: string -> string -> string -> string
|
||||
(** [temp_file prefix suffix] returns the name of a
|
||||
|
|
Loading…
Reference in New Issue