Fixed the implementation of Filename.{split_,}ext
This commit is contained in:
parent
d62429455b
commit
99b0d94335
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 = "."
|
||||
|}]
|
|
@ -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} ${<})))))
|
||||
|
|
Loading…
Reference in New Issue