Filename.chop_suffix_opt (#2125)
parent
0e5cae8dc6
commit
a7a76fd4e8
3
Changes
3
Changes
|
@ -136,6 +136,9 @@ Working version
|
|||
- GPR#2119: clarify the documentation of Set.diff
|
||||
(Gabriel Scherer, suggestion by John Skaller)
|
||||
|
||||
- MPR#7812, GPR#2125: Add Filename.chop_suffix_opt
|
||||
(Alain Frisch, review by Nicolás Ojeda Bär, suggestion by whitequark)
|
||||
|
||||
### Other libraries:
|
||||
|
||||
- GPR#1061: Add ?follow parameter to Unix.link. This allows hardlinking
|
||||
|
|
|
@ -83,6 +83,18 @@ module Unix = struct
|
|||
String.length name >= String.length suff &&
|
||||
String.sub name (String.length name - String.length suff)
|
||||
(String.length suff) = suff
|
||||
|
||||
let chop_suffix_opt ~suffix filename =
|
||||
let len_s = String.length suffix and len_f = String.length filename in
|
||||
if len_f >= len_s then
|
||||
let r = String.sub filename (len_f - len_s) len_s in
|
||||
if r = suffix then
|
||||
Some (String.sub filename 0 (len_f - len_s))
|
||||
else
|
||||
None
|
||||
else
|
||||
None
|
||||
|
||||
let temp_dir_name =
|
||||
try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
|
||||
let quote = generic_quote "'\\''"
|
||||
|
@ -110,6 +122,19 @@ module Win32 = struct
|
|||
(let s = String.sub name (String.length name - String.length suff)
|
||||
(String.length suff) in
|
||||
String.lowercase_ascii s = String.lowercase_ascii suff)
|
||||
|
||||
let chop_suffix_opt ~suffix filename =
|
||||
let len_s = String.length suffix and len_f = String.length filename in
|
||||
if len_f >= len_s then
|
||||
let r = String.sub filename (len_f - len_s) len_s in
|
||||
if String.lowercase_ascii r = String.lowercase_ascii suffix then
|
||||
Some (String.sub filename 0 (len_f - len_s))
|
||||
else
|
||||
None
|
||||
else
|
||||
None
|
||||
|
||||
|
||||
let temp_dir_name =
|
||||
try Sys.getenv "TEMP" with Not_found -> "."
|
||||
let quote s =
|
||||
|
@ -163,6 +188,7 @@ module Cygwin = struct
|
|||
let is_relative = Win32.is_relative
|
||||
let is_implicit = Win32.is_implicit
|
||||
let check_suffix = Win32.check_suffix
|
||||
let chop_suffix_opt = Win32.chop_suffix_opt
|
||||
let temp_dir_name = Unix.temp_dir_name
|
||||
let quote = Unix.quote
|
||||
let basename = generic_basename is_dir_sep current_dir_name
|
||||
|
@ -170,23 +196,27 @@ module Cygwin = struct
|
|||
end
|
||||
|
||||
let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
|
||||
is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
|
||||
is_relative, is_implicit, check_suffix, chop_suffix_opt,
|
||||
temp_dir_name, quote, basename,
|
||||
dirname) =
|
||||
match Sys.os_type with
|
||||
| "Win32" ->
|
||||
(Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
|
||||
Win32.is_dir_sep,
|
||||
Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
|
||||
Win32.chop_suffix_opt,
|
||||
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.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
|
||||
Cygwin.chop_suffix_opt,
|
||||
Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
|
||||
| _ -> (* normally "Unix" *)
|
||||
(Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
|
||||
Unix.is_dir_sep,
|
||||
Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
|
||||
Unix.chop_suffix_opt,
|
||||
Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
|
||||
|
||||
let concat dirname filename =
|
||||
|
|
|
@ -42,12 +42,33 @@ val is_implicit : string -> bool
|
|||
|
||||
val check_suffix : string -> string -> bool
|
||||
(** [check_suffix name suff] returns [true] if the filename [name]
|
||||
ends with the suffix [suff]. *)
|
||||
ends with the suffix [suff].
|
||||
|
||||
Under Windows ports (including Cygwin), comparison is
|
||||
case-insensitive, relying on [String.lowercase_ascii]. Note that
|
||||
this does not match exactly the interpretation of case-insensitive
|
||||
filename equivalence from Windows. *)
|
||||
|
||||
val chop_suffix : string -> string -> string
|
||||
(** [chop_suffix name suff] removes the suffix [suff] from
|
||||
the filename [name]. The behavior is undefined if [name] does not
|
||||
end with the suffix [suff]. *)
|
||||
end with the suffix [suff]. It is thus recommmended to use
|
||||
[chop_suffix_opt] instead.
|
||||
*)
|
||||
|
||||
val chop_suffix_opt: suffix:string -> string -> string option
|
||||
(** [chop_suffix_opt ~suffix filename] removes the suffix from
|
||||
the [filename] if possible, or returns [None] if the
|
||||
filename does not end with the suffix.
|
||||
|
||||
Under Windows ports (including Cygwin), comparison is
|
||||
case-insensitive, relying on [String.lowercase_ascii]. Note that
|
||||
this does not match exactly the interpretation of case-insensitive
|
||||
filename equivalence from Windows.
|
||||
|
||||
@since 4.08
|
||||
*)
|
||||
|
||||
|
||||
val extension : string -> string
|
||||
(** [extension name] is the shortest suffix [ext] of [name0] where:
|
||||
|
|
|
@ -1 +1,2 @@
|
|||
extension.ml
|
||||
suffix.ml
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
(* TEST
|
||||
*)
|
||||
|
||||
let () =
|
||||
let test ~suffix name exp =
|
||||
let r1 = Filename.chop_suffix_opt ~suffix name <> None in
|
||||
let r2 = Filename.check_suffix name suffix in
|
||||
assert (r1 = r2);
|
||||
assert (r1 = exp)
|
||||
in
|
||||
let full_test ~suffix name =
|
||||
test ~suffix name true;
|
||||
match Filename.chop_suffix_opt ~suffix name with
|
||||
| None -> assert false
|
||||
| Some base -> assert (base ^ suffix = name)
|
||||
in
|
||||
let win32 = Sys.os_type = "Win32" || Sys.os_type = "Cygwin" in
|
||||
full_test ~suffix:".txt" "foo.txt";
|
||||
full_test ~suffix:"txt" "foo.txt";
|
||||
full_test ~suffix:"" "foo.txt";
|
||||
full_test ~suffix:"" "";
|
||||
test ~suffix:".txt" "f" false;
|
||||
test ~suffix:".txt" "" false;
|
||||
test ~suffix:".txt" "foo.txt.bak" false;
|
||||
test ~suffix:".txt" "foo.TXT" win32;
|
||||
if win32 then
|
||||
assert (Filename.chop_suffix_opt ~suffix:".txt" "foo.TXT" = Some "foo")
|
Loading…
Reference in New Issue