diff --git a/bin/main.ml b/bin/main.ml index f77b0bf2..e9d20176 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -116,7 +116,7 @@ let request_of_targets (setup : Main.setup) targets = match target with | File path -> Build.path path | Alias_rec path -> - let dir = Path.parent path in + let dir = Path.parent_exn path in let name = Path.basename path in let contexts, dir = match Path.extract_build_context dir with @@ -594,11 +594,7 @@ let resolve_package_install setup pkg = let target_hint (setup : Main.setup) path = assert (Path.is_local path); - let sub_dir = - if Path.is_root path then - path - else - Path.parent path in + let sub_dir = Option.value ~default:path (Path.parent path) in let candidates = Build_system.all_targets setup.build_system in let candidates = if Path.is_in_build_dir path then @@ -613,7 +609,7 @@ let target_hint (setup : Main.setup) path = (* Only suggest hints for the basename, otherwise it's slow when there are lots of files *) List.filter_map candidates ~f:(fun path -> - if Path.parent path = sub_dir then + if Path.parent_exn path = sub_dir then Some (Path.to_string path) else None) diff --git a/src/action.ml b/src/action.ml index 4b266009..67295852 100644 --- a/src/action.ml +++ b/src/action.ml @@ -801,10 +801,9 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Io.copy_file ~src ~dst else begin let src = - if Path.is_root dst then - Path.to_string src - else - Path.reach ~from:(Path.parent dst) src + match Path.parent dst with + | None -> Path.to_string src + | Some from -> Path.reach ~from src in let dst = Path.to_string dst in match Unix.readlink dst with diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 7144a23b..918fb82f 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -45,7 +45,7 @@ let inspect_path file_tree path = if Path.is_root path then Some Dir else if File_tree.file_exists file_tree - (Path.parent path) + (Path.parent_exn path) (Path.basename path) then Some Reg else @@ -97,7 +97,7 @@ let static_deps t ~all_targets ~file_tree = match !state with | Decided (_, t) -> loop t acc | Undecided (then_, else_) -> - let dir = Path.parent p in + let dir = Path.parent_exn p in let targets = all_targets ~dir in if Pset.mem targets p then begin state := Decided (true, then_); @@ -208,10 +208,10 @@ module Rule = struct | [] -> invalid_arg "Build_interpret.Rule.make: rule has no targets" | x :: l -> - let dir = Path.parent (Target.path x) in + let dir = Path.parent_exn (Target.path x) in List.iter l ~f:(fun target -> let path = Target.path target in - if Path.parent path <> dir then + if Path.parent_exn path <> dir then match loc with | None -> Exn.code_error "rule has targets in different directories" diff --git a/src/build_system.ml b/src/build_system.ml index bf80a312..52d3d7b5 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -236,7 +236,7 @@ module Alias0 = struct Loc.fail loc "Invalid alias!\n\ Tried to reference path outside build dir: %S" (Path.to_string_maybe_quoted path); - { dir = Path.parent path + { dir = Path.parent_exn path ; name = Path.basename path } end @@ -536,7 +536,7 @@ let add_spec t fn spec ~copy_source = | Some (File_spec.T { rule; _ }) -> match copy_source, rule.mode with | true, (Standard | Not_a_rule_stanza) -> - Loc.warn (Internal_rule.loc rule ~dir:(Path.parent fn) + Loc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn) ~file_tree:t.file_tree) "File %s is both generated by a rule and present in the source tree.\n\ As a result, the rule is currently ignored, however this will become an error \ @@ -1056,7 +1056,7 @@ and wait_for_file t fn = match Hashtbl.find t.files fn with | Some file -> wait_for_file_found fn file | None -> - let dir = Path.parent fn in + let dir = Path.parent_exn fn in if Path.is_in_build_dir dir then begin load_dir t ~dir; match Hashtbl.find t.files fn with @@ -1247,7 +1247,8 @@ module Ir_set = Set.Make(Internal_rule) let rules_for_files t paths = List.filter_map paths ~f:(fun path -> - if Path.is_in_build_dir path then load_dir t ~dir:(Path.parent path); + if Path.is_in_build_dir path then + load_dir t ~dir:(Path.parent_exn path); match Hashtbl.find t.files path with | None -> None | Some (File_spec.T { rule; _ }) -> Some rule) @@ -1341,8 +1342,9 @@ let build_rules_internal ?(recursive=false) t ~request = let rules_seen = ref Rule.Id.Set.empty in let rules = ref [] in let rec loop fn = - let dir = Path.parent fn in - if Path.is_in_build_dir dir then load_dir t ~dir; + let dir = Path.parent_exn fn in + if Path.is_in_build_dir dir then + load_dir t ~dir; match Hashtbl.find t.files fn with | Some file -> file_found fn file @@ -1462,9 +1464,9 @@ let package_deps t pkg files = let rec add_build_dir_to_keep t ~dir = if not (Pset.mem t.build_dirs_to_keep dir) then begin t.build_dirs_to_keep <- Pset.add t.build_dirs_to_keep dir; - let dir = Path.parent dir in - if not (Path.is_root dir) then - add_build_dir_to_keep t ~dir + Option.iter (Path.parent dir) ~f:(fun dir -> + if not (Path.is_root dir) then + add_build_dir_to_keep t ~dir) end let get_collector t ~dir = @@ -1577,4 +1579,5 @@ module Alias = struct } :: def.actions end -let is_target t file = Pset.mem (targets_of t ~dir:(Path.parent file)) file +let is_target t file = + Pset.mem (targets_of t ~dir:(Path.parent_exn file)) file diff --git a/src/context.ml b/src/context.ml index f8ac6f7f..351a312e 100644 --- a/src/context.ml +++ b/src/context.ml @@ -181,7 +181,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () = | Some x -> x | None -> prog_not_found_in_path "ocamlc" in - let dir = Path.parent ocamlc in + let dir = Path.parent_exn ocamlc in let ocaml_tool_not_found prog = die "ocamlc found in %s, but %s/%s doesn't exist (context: %s)" (Path.to_string dir) (Path.to_string dir) prog name @@ -246,7 +246,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () = | None -> (* If neither opam neither ocamlfind are present, assume that libraries are [dir ^ "/../lib"] *) - ocamlpath @ [Path.relative (Path.parent dir) "lib"] + ocamlpath @ [Path.relative (Path.parent_exn dir) "lib"] in let ocaml_config_ok_exn = function | Ok x -> x @@ -460,7 +460,7 @@ let which t s = which ~cache:t.which_cache ~path:t.path s let install_prefix t = opam_config_var t "prefix" >>| function | Some x -> Path.absolute x - | None -> Path.parent t.ocaml_bin + | None -> Path.parent_exn t.ocaml_bin let install_ocaml_libdir t = match t.kind, t.findlib_toolchain, Setup.library_destdir with diff --git a/src/file_tree.ml b/src/file_tree.ml index 535038bd..067f163a 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -131,7 +131,8 @@ let rec find_dir t path = | None -> match let open Option.O in - find_dir t (Path.parent path) + Path.parent path + >>= find_dir t >>= fun parent -> String.Map.find (Dir.sub_dirs parent) (Path.basename path) with @@ -159,7 +160,7 @@ let dir_exists t path = Option.is_some (find_dir t path) let exists t path = dir_exists t path || - file_exists t (Path.parent path) (Path.basename path) + file_exists t (Path.parent_exn path) (Path.basename path) let files_recursively_in t ?(prefix_with=Path.root) path = match find_dir t path with diff --git a/src/gen_rules.ml b/src/gen_rules.ml index c1bfd953..dc060a4b 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -211,7 +211,7 @@ module Gen(P : Install_rules.Params) = struct Loc.fail loc "%s is not a sub-directory of %s" (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir); let glob = Path.basename glob_in_src in - let src_in_src = Path.parent glob_in_src in + let src_in_src = Path.parent_exn glob_in_src in let re = match Glob_lexer.parse_string glob with | Ok re -> @@ -967,7 +967,7 @@ module Gen(P : Install_rules.Params) = struct let src_dir = let loc = String_with_vars.loc glob in let src_glob = SC.expand_vars sctx ~dir glob ~scope in - Path.parent (Path.relative src_dir src_glob ~error_loc:loc) + Path.parent_exn (Path.relative src_dir src_glob ~error_loc:loc) in Some (Merlin.make () @@ -997,7 +997,7 @@ module Gen(P : Install_rules.Params) = struct Option.is_none (File_tree.find_dir (SC.file_tree sctx) (Path.drop_build_context_exn dir)) then - SC.load_dir sctx ~dir:(Path.parent dir)); + SC.load_dir sctx ~dir:(Path.parent_exn dir)); match components with | [] -> These (String.Set.of_list [".js"; "_doc"; ".ppx"]) | [(".js"|"_doc"|".ppx")] -> All diff --git a/src/jbuild.ml b/src/jbuild.ml index 3c933305..49ba8564 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1291,7 +1291,7 @@ module Stanzas = struct ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) ; cstr_loc "include" (relative_file @> nil) (fun loc fn -> let include_stack = (loc, file) :: include_stack in - let dir = Path.parent file in + let dir = Path.parent_exn file in let file = Path.relative dir fn in if not (Path.exists file) then Loc.fail loc "File %s doesn't exist." diff --git a/src/scope.ml b/src/scope.ml index 7abdc431..52711100 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -31,7 +31,7 @@ module DB = struct [ "dir" , Path.sexp_of_t dir ; "context", Sexp.To_sexp.string t.context ]; - let scope = loop (Path.parent d) in + let scope = loop (Path.parent_exn d) in Hashtbl.add t.by_dir d scope; scope in diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 9c9f11ad..5931876f 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -341,8 +341,20 @@ let basename t = let parent t = match kind t with - | Local t -> Local.parent t - | External t -> Filename.dirname t + | Local "" -> None + | Local t -> Some (Local.parent t) + | External t -> + let parent = Filename.dirname t in + if parent = t then + None + else + Some parent + +let parent_exn t = + match parent t with + | Some p -> p + | None -> Exn.code_error "Path.parent_exn: t is root" + ["t", sexp_of_t t] let build_prefix = "_build/" diff --git a/src/stdune/path.mli b/src/stdune/path.mli index d9db2bbd..44663266 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -78,7 +78,8 @@ val is_descendant : t -> of_:t -> bool val append : t -> t -> t val basename : t -> string -val parent : t -> t +val parent : t -> t option +val parent_exn : t -> t val extend_basename : t -> suffix:string -> t diff --git a/src/super_context.ml b/src/super_context.ml index 29e8aaeb..e60b6da8 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -113,10 +113,13 @@ module Env = struct let rec get t ~dir = match Hashtbl.find t.env dir with | None -> - if Path.is_root dir then raise_notrace Exit; - let node = get t ~dir:(Path.parent dir) in - Hashtbl.add t.env dir node; - node + begin match Path.parent dir with + | None -> raise_notrace Exit + | Some parent -> + let node = get t ~dir:parent in + Hashtbl.add t.env dir node; + node + end | Some node -> node let get t ~dir = @@ -334,7 +337,7 @@ let create if ctx_dir = Scope.root scope then None else - Some (lazy (Env.get t ~dir:(Path.parent ctx_dir))) + Some (lazy (Env.get t ~dir:(Path.parent_exn ctx_dir))) in Hashtbl.add t.env ctx_dir { dir = ctx_dir @@ -480,7 +483,7 @@ module Deps = struct Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s) in match Glob_lexer.parse_string (Path.basename path) with | Ok re -> - let dir = Path.parent path in + let dir = Path.parent_exn path in Build.paths_glob ~loc ~dir (Re.compile re) | Error (_pos, msg) -> Loc.fail loc "invalid glob: %s" msg @@ -793,7 +796,7 @@ module Action = struct in let targets = Pset.to_list targets in List.iter targets ~f:(fun target -> - if Path.parent target <> dir then + if Path.parent_exn target <> dir then Loc.fail loc "This action has targets in a different directory than the current \ one, this is not allowed by Jbuilder at the moment:\n%s" diff --git a/src/utils.ml b/src/utils.ml index 8cca616e..8afc656f 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -85,7 +85,7 @@ let analyse_target fn = assert (String.length digest = 32); name in - Alias (ctx, Path.relative (Path.parent fn) basename) + Alias (ctx, Path.relative (Path.parent_exn fn) basename) end | Some ("install", _) -> Other fn | Some (ctx, sub) -> Regular (ctx, sub) diff --git a/test/unit-tests/path.mlt b/test/unit-tests/path.mlt index a5fca503..1ef71864 100644 --- a/test/unit-tests/path.mlt +++ b/test/unit-tests/path.mlt @@ -163,6 +163,6 @@ Path.rm_rf (Path.of_string "/does/not/exist/foo/bar/baz") [%%expect{| Exception: Stdune__Exn.Code_error . Raised at file "src/stdune/exn.ml", line 30, characters 37-131 -Called from file "src/stdune/path.ml", line 496, characters 4-127 +Called from file "src/stdune/path.ml", line 505, characters 4-127 Called from file "toplevel/toploop.ml", line 180, characters 17-56 |}]