diff options
Diffstat (limited to 'stdlib/filename.ml')
| -rw-r--r-- | stdlib/filename.ml | 86 |
1 files changed, 52 insertions, 34 deletions
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 - -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 + if name = "" + then current_dir_name + else find_end (String.length name - 1) + +(* 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 |