diff --git a/src/future.ml b/src/future.ml index 58174ca0..be1d3f3f 100644 --- a/src/future.ml +++ b/src/future.ml @@ -375,11 +375,11 @@ module Scheduler = struct let (similar, rest) = List.partition ~f:(eq_ext x) xs in (x :: similar) :: group_by_ext rest in let pp_ext ppf filename = - let ext = match Filename.ext filename with - | Some s when s.[0] = '.' -> - String.sub ~pos:1 ~len:(String.length s - 1) s - | Some s -> s - | None -> "" in + let ext = + match Filename.extension filename with + | "" -> "" + | s -> String.sub ~pos:1 ~len:(String.length s - 1) s + in Format.fprintf ppf "%s" ext in let pp_comma ppf () = Format.fprintf ppf "," in let pp_group ppf = function diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 18b7479f..68fb18a1 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -492,9 +492,9 @@ module Gen(P : Params) = struct let files = List.filter_map (String_map.values modules) ~f:(fun m -> Module.file ~dir m ml_kind) |> List.map ~f:(fun fn -> - match ml_kind, Filename.ext (Path.to_string fn) with - | Impl, Some ".ml" -> Arg_spec.Dep fn - | Intf, Some ".mli" -> Dep fn + match ml_kind, Filename.extension (Path.to_string fn) with + | Impl, ".ml" -> Arg_spec.Dep fn + | Intf, ".mli" -> Dep fn | Impl, _ -> S [A "-impl"; Dep fn] | Intf, _ -> S [A "-intf"; Dep fn]) in @@ -651,12 +651,10 @@ module Gen(P : Params) = struct +-----------------------------------------------------------------+ *) let pp_fname fn = - match Filename.split_ext fn with - | None -> fn ^ ".pp" - | Some (fn, ext) -> - (* We need to to put the .pp before the .ml so that the compiler realises that - [foo.pp.mli] is the interface for [foo.pp.ml] *) - fn ^ ".pp" ^ ext + let fn, ext = Filename.split_extension fn in + (* We need to to put the .pp before the .ml so that the compiler realises that + [foo.pp.mli] is the interface for [foo.pp.ml] *) + fn ^ ".pp" ^ ext let pped_module ~dir (m : Module.t) ~f = let ml_pp_fname = pp_fname m.ml_fname in @@ -1136,9 +1134,7 @@ module Gen(P : Params) = struct cmi exists and reads it instead of re-creating it, which could create a race condition. *) ([ "-intf-suffix" - ; match Filename.ext m.ml_fname with - | None -> "" - | Some ext -> ext + ; Filename.extension m.ml_fname ], [Module.cm_file m ~dir Cmi], []) | Cmi, None -> assert false diff --git a/src/import.ml b/src/import.ml index ec040ae4..3d84c72b 100644 --- a/src/import.ml +++ b/src/import.ml @@ -279,20 +279,48 @@ end module Filename = struct include Filename - let split_ext fn = - match String.rindex fn '.' with - | exception Not_found -> None - | i -> - Some - (String.sub fn ~pos:0 ~len:i, - String.sub fn ~pos:i ~len:(String.length fn - i)) + (* Return the index of the start of the extension, using the same semantic as + [Filename.extension] in 4.04 *) + let extension_start = + (* This is from the win32 implementation, but it is acceptable for the usage we make + of it in this function and covers all platforms. *) + let is_dir_sep = function + | '/' | '\\' | ':' -> true + | _ -> false + in + let rec check_at_least_one_non_dot s len candidate i = + if i < 0 then + len + else + match s.[i] with + | '.' -> + check_at_least_one_non_dot s len candidate (i - 1) + | c -> + if is_dir_sep c then + len + else + candidate + in + let rec search_dot s len i = + if i <= 0 then + len + else + match s.[i] with + | '.' -> check_at_least_one_non_dot s len i (i - 1) + | c -> if is_dir_sep c then len else search_dot s len (i - 1) + in + fun s -> + let len = String.length s in + search_dot s len (len - 1) - let ext fn = - match String.rindex fn '.' with - | exception Not_found -> None - | i -> - Some - (String.sub fn ~pos:i ~len:(String.length fn - i)) + let split_extension fn = + let i = extension_start fn in + (String.sub fn ~pos:0 ~len:i, + String.sub fn ~pos:i ~len:(String.length fn - i)) + + let extension fn = + let i = extension_start fn in + String.sub fn ~pos:i ~len:(String.length fn - i) end module Option = struct diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index b31b8c8a..56e26ed7 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -154,8 +154,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () = let files = File_tree.Dir.files dir in let pkgs = String_set.fold files ~init:pkgs ~f:(fun fn acc -> - match Filename.split_ext fn with - | Some (pkg, ".opam") when pkg <> "" -> + match Filename.split_extension fn with + | (pkg, ".opam") when pkg <> "" -> let version_from_opam_file = let lines = lines_of_file (Path.relative path fn |> Path.to_string) in List.find_map lines ~f:(fun s -> diff --git a/test/expect-tests/expect_test.mll b/test/expect-tests/expect_test.mll index aa3ae112..9d20f1ad 100644 --- a/test/expect-tests/expect_test.mll +++ b/test/expect-tests/expect_test.mll @@ -107,7 +107,7 @@ let main () = let corrected_fn = fn ^ ".corrected" in (* Temporary hack: *) - (* Sys.chdir "../.."; *) + if Filename.basename (Sys.getcwd ()) = "default" then Sys.chdir "../.."; if txt <> res then begin let oc = open_out_bin corrected_fn in output_string oc res; diff --git a/test/expect-tests/filename.mlt b/test/expect-tests/filename.mlt new file mode 100644 index 00000000..2c53ea86 --- /dev/null +++ b/test/expect-tests/filename.mlt @@ -0,0 +1,56 @@ +(* -*- tuareg -*- *) + +#warnings "-40";; + +open Jbuilder;; +open Import;; + +Filename.extension "toto.titi";; +[%%expect{| +- : string = ".titi" +|}] + +Filename.extension "toto.";; +[%%expect{| +- : string = "." +|}] + +Filename.extension ".";; +[%%expect{| +- : string = "" +|}] + +Filename.extension ".titi";; +[%%expect{| +- : string = "" +|}] + +Filename.extension ".a";; +[%%expect{| +- : string = "" +|}] + +Filename.extension "a.";; +[%%expect{| +- : string = "." +|}] + +Filename.extension "a.a";; +[%%expect{| +- : string = ".a" +|}] + +Filename.extension "truc/a.a";; +[%%expect{| +- : string = ".a" +|}] + +Filename.extension "truc/.a";; +[%%expect{| +- : string = "" +|}] + +Filename.extension "truc/a.";; +[%%expect{| +- : string = "." +|}] diff --git a/test/expect-tests/jbuild b/test/expect-tests/jbuild index 08409113..908ec100 100644 --- a/test/expect-tests/jbuild +++ b/test/expect-tests/jbuild @@ -15,3 +15,10 @@ (glob_files ${ROOT}/vendor/re/*.cmi) (files_recursively_in findlib-db))) (action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<}))))) + +(alias + ((name runtest) + (deps (filename.mlt + (glob_files ${ROOT}/src/*.cmi) + (glob_files ${ROOT}/vendor/re/*.cmi))) + (action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))