diff --git a/Changes b/Changes index 4104ee419..c2787304a 100644 --- a/Changes +++ b/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 diff --git a/VERSION b/VERSION index fe54d2adb..49ebc9c38 100644 --- a/VERSION +++ b/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 diff --git a/stdlib/filename.ml b/stdlib/filename.ml index 92bd21718..8c3ad5315 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -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 diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 7e447585c..b4644ad67 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -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