diff --git a/compiler/catala_utils/file.ml b/compiler/catala_utils/file.ml index 378ee687..619aa5ab 100644 --- a/compiler/catala_utils/file.ml +++ b/compiler/catala_utils/file.ml @@ -35,18 +35,41 @@ let temp_file pfx sfx = f let ( / ) a b = if a = Filename.current_dir_name then b else Filename.concat a b +let dir_sep_char = Filename.dir_sep.[0] let rec parent f = let base = Filename.basename f in - if base = Filename.parent_dir_name then parent (Filename.dirname f) / base + if base = Filename.parent_dir_name || base = Filename.current_dir_name then + parent (Filename.dirname f) / base else Filename.dirname f +let clean_path p = + let ( / ) a b = if b = "" then a else a / b in + let nup, p = + List.fold_right + (fun d (nup, acc) -> + if d = Filename.current_dir_name then nup, acc + else if d = Filename.parent_dir_name then nup + 1, acc + else if nup > 0 then nup - 1, acc + else nup, d / acc) + (String.split_on_char dir_sep_char p) + (0, "") + in + let p = + if nup = 0 then p + else + String.concat Filename.dir_sep + (List.init nup (fun _ -> Filename.parent_dir_name)) + / p + in + if p = "" then "." else p + let rec ensure_dir dir = match Sys.is_directory dir with | true -> () | false | (exception Sys_error _) -> let pdir = parent dir in - if pdir <> dir then ensure_dir (Filename.dirname dir); + if pdir <> dir then ensure_dir pdir; Sys.mkdir dir 0o777 (* will be affected by umask, most likely restricted to 0o755 *) @@ -143,8 +166,6 @@ let get_command t = "/bin/sh" ["-c"; "command -v " ^ Filename.quote t] -let dir_sep_char = Filename.dir_sep.[0] - let check_exec t = try if String.contains t dir_sep_char then Unix.realpath t else get_command t with Unix.Unix_error _ | Sys_error _ -> diff --git a/compiler/catala_utils/file.mli b/compiler/catala_utils/file.mli index b279029a..dd1c28f1 100644 --- a/compiler/catala_utils/file.mli +++ b/compiler/catala_utils/file.mli @@ -104,8 +104,11 @@ val dirname : t -> t (** [Filename.dirname], re-exported for convenience *) val parent : t -> t -(** Similar to [dirname], except it strips the last **non-".."** element in the - supplied file name *) +(** Similar to [dirname], except it strips the last **non-"." or ".."** element in the + supplied file name, if it exists *) + +val clean_path : t -> t +(** Rewrites a path by removing intermediate relative lookups ("." and ".."). E.g. [../foo/./bar/../baz/] becomes [../foo/baz]. No disk lookup is made by this function. *) val ( /../ ) : t -> t -> t (** Sugar for [parent a / b] *) diff --git a/compiler/driver.ml b/compiler/driver.ml index 3c1cbac0..6e2d7c5e 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -1047,7 +1047,8 @@ module Commands = struct else File.(pfx / f) in let f = - match extension with None -> f | Some ext -> File.(f -.- ext) + File.clean_path + @@ match extension with None -> f | Some ext -> File.(f -.- ext) in Format.pp_print_string ppf f) Format.std_formatter modules_list_topo;