From 81a9a14a8db187a7b8eba47cc7f620f704c5ecbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Tue, 2 Mar 2021 20:41:58 +0000 Subject: [PATCH] Remove the external-lib-deps command (#4298) Signed-off-by: Jeremie Dimino --- CHANGES.md | 4 + bin/build_cmd.ml | 8 +- bin/clean.ml | 2 +- bin/common.ml | 18 +- bin/common.mli | 25 +-- bin/compute.ml | 2 +- bin/describe.ml | 2 +- bin/exec.ml | 2 +- bin/external_lib_deps.ml | 188 ++---------------- bin/import.ml | 1 - bin/init.ml | 2 +- bin/install_uninstall.ml | 2 +- bin/installed_libraries.ml | 2 +- bin/ocaml_merlin.ml | 4 +- bin/print_rules.ml | 2 +- bin/printenv.ml | 2 +- bin/promote.ml | 2 +- bin/rpc.ml | 2 +- bin/top.ml | 2 +- bin/upgrade.ml | 2 +- bin/utop.ml | 3 +- src/dune_engine/action_builder.ml | 52 ----- src/dune_engine/action_builder.mli | 8 - src/dune_engine/clflags.ml | 4 - src/dune_engine/clflags.mli | 5 - src/dune_rules/buildable_rules.ml | 9 +- src/dune_rules/cinaps.ml | 4 +- src/dune_rules/dep_conf_eval.ml | 1 - src/dune_rules/dune_file.ml | 11 - src/dune_rules/dune_file.mli | 2 - src/dune_rules/dune_rules.ml | 1 - src/dune_rules/exe_rules.ml | 4 +- src/dune_rules/expander.ml | 16 +- src/dune_rules/expander.mli | 2 - src/dune_rules/format_rules.ml | 4 +- src/dune_rules/install_rules.ml | 12 +- src/dune_rules/lib.ml | 65 +----- src/dune_rules/lib.mli | 3 - src/dune_rules/lib_deps_info.ml | 46 ----- src/dune_rules/lib_deps_info.mli | 27 --- src/dune_rules/lib_rules.ml | 8 +- src/dune_rules/merlin.ml | 1 - src/dune_rules/preprocessing.ml | 29 ++- src/dune_rules/preprocessing.mli | 4 +- src/dune_rules/super_context.ml | 1 - src/dune_rules/toplevel.ml | 8 +- src/dune_rules/utop.ml | 6 +- .../deprecated-library-name/features.t | 2 - .../enabled_if/eif-context_name.t/run.t | 2 - .../enabled_if/eif-ocaml_version.t/run.t | 2 - .../test-cases/enabled_if/eif-simple.t/run.t | 2 - .../test-cases/exec-missing.t/run.t | 2 - .../test-cases/external-lib-deps.t | 5 + .../external-lib-deps/github3143.t/run.t | 13 -- .../external-lib-deps/missing.t/dune | 18 -- .../external-lib-deps/missing.t/dune-project | 4 - .../external-lib-deps/missing.t/run.t | 17 -- .../external-lib-deps/simple.t/dune | 18 -- .../external-lib-deps/simple.t/dune-project | 4 - .../external-lib-deps/simple.t/run.t | 14 -- .../test-cases/findlib.t/dune-project | 1 - .../test-cases/findlib.t/foo.opam | 0 .../blackbox-tests/test-cases/findlib.t/run.t | 31 --- .../test-cases/findlib.t/src/dune | 4 - .../test-cases/findlib.t/src/foo.ml | 1 - .../test-cases/findlib.t/test/dune | 3 - .../test-cases/foreign-library.t/run.t | 2 - .../test-cases/github1541.t/run.t | 4 - .../test-cases/github25.t/run.t | 2 - .../test-cases/github644.t/dune | 5 - .../test-cases/github644.t/dune-project | 1 - .../test-cases/github644.t/foo.ml | 1 - .../test-cases/github644.t/run.t | 21 -- test/blackbox-tests/test-cases/lib.t/run.t | 2 - .../blackbox-tests/test-cases/libexec.t/run.t | 2 - .../test-cases/optional-executable.t/run.t | 6 - .../test-cases/optional.t/run.t | 2 - .../ppx-cross-context-issue.t/run.t | 2 - .../virtual-libraries/no-vlib-present.t/run.t | 2 - 79 files changed, 85 insertions(+), 720 deletions(-) delete mode 100644 src/dune_rules/lib_deps_info.ml delete mode 100644 src/dune_rules/lib_deps_info.mli create mode 100644 test/blackbox-tests/test-cases/external-lib-deps.t delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/github3143.t/run.t delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune-project delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/missing.t/run.t delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune-project delete mode 100644 test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t delete mode 100644 test/blackbox-tests/test-cases/findlib.t/dune-project delete mode 100644 test/blackbox-tests/test-cases/findlib.t/foo.opam delete mode 100644 test/blackbox-tests/test-cases/findlib.t/run.t delete mode 100644 test/blackbox-tests/test-cases/findlib.t/src/dune delete mode 100644 test/blackbox-tests/test-cases/findlib.t/src/foo.ml delete mode 100644 test/blackbox-tests/test-cases/findlib.t/test/dune delete mode 100644 test/blackbox-tests/test-cases/github644.t/dune delete mode 100644 test/blackbox-tests/test-cases/github644.t/dune-project delete mode 100644 test/blackbox-tests/test-cases/github644.t/foo.ml delete mode 100644 test/blackbox-tests/test-cases/github644.t/run.t diff --git a/CHANGES.md b/CHANGES.md index 3e5a33bcaf7..bfbe5c0692a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -74,6 +74,10 @@ Unreleased - Automatically delete left-over Merlin files when rebuilding for the first time a project previously built with Dune `<= 2.7`. (#4261, @voodoos, @aalekseyev) +- Remove the `external-lib-deps` command. This command was only + approximative and the cost of maintainance was getting too high. We + removed it to make room for new more important features + 2.8.2 (21/01/2021) ------------------ diff --git a/bin/build_cmd.ml b/bin/build_cmd.ml index b1dd6f09041..9ee8c3e201d 100644 --- a/bin/build_cmd.ml +++ b/bin/build_cmd.ml @@ -72,11 +72,7 @@ let runtest = let term = let+ common = Common.term and+ dirs = Arg.(value & pos_all string [ "." ] name_) in - Common.set_common common - ~targets: - (List.map dirs ~f:(fun s -> - let dir = Path.Local.of_string s in - Arg.Dep.alias_rec ~dir Dune_engine.Alias.Name.runtest)); + Common.set_common common; let targets (setup : Import.Main.build_system) = List.map dirs ~f:(fun dir -> let dir = Path.(relative root) (Common.prefix_target common dir) in @@ -116,7 +112,7 @@ let build = | [] -> [ Common.default_target common ] | _ :: _ -> targets in - Common.set_common common ~targets; + Common.set_common common; let targets setup = Target.resolve_targets_exn common setup targets in run_build_command ~common ~targets in diff --git a/bin/clean.ml b/bin/clean.ml index 67d2c5dc162..105b2bbbeb4 100644 --- a/bin/clean.ml +++ b/bin/clean.ml @@ -17,7 +17,7 @@ let command = includes deleting the log file. Not only creating the log file would be useless but with some FS this also causes [dune clean] to fail (cf https://github.com/ocaml/dune/issues/2964). *) - Common.set_common common ~targets:[] ~log_file:No_log_file; + Common.set_common common ~log_file:No_log_file; Build_system.files_in_source_tree_to_delete () |> Path.Set.iter ~f:Path.unlink_no_err; Path.rm_rf Path.build_dir diff --git a/bin/common.ml b/bin/common.ml index 646908e557f..0c66aeed623 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -114,12 +114,10 @@ let normalize_path path = else path -let set_dirs c = +let set_common ?log_file c = if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir; Path.set_root (normalize_path (Path.External.cwd ())); - Path.Build.set_build_dir (Path.Build.Kind.of_string c.build_dir) - -let set_common_other ?log_file c ~targets = + Path.Build.set_build_dir (Path.Build.Kind.of_string c.build_dir); Dune_config.init c.config; Dune_util.Log.init () ?file:log_file; Clflags.debug_dep_path := c.debug_dep_path; @@ -134,22 +132,10 @@ let set_common_other ?log_file c ~targets = Clflags.no_print_directory := c.no_print_directory; Clflags.store_orig_src_dir := c.store_orig_src_dir; Clflags.promote_install_files := c.promote_install_files; - Clflags.external_lib_deps_hint := - List.concat - [ [ "dune"; "external-lib-deps"; "--missing" ] - ; c.orig_args - ; List.map ~f:Arg.Dep.to_string_maybe_quoted targets - ]; Clflags.always_show_command_line := c.always_show_command_line; Clflags.ignore_promoted_rules := c.ignore_promoted_rules; Option.iter ~f:Dune_engine.Stats.enable c.stats_trace_file -let set_common ?log_file ?external_lib_deps_mode c ~targets = - Option.iter external_lib_deps_mode ~f:(fun x -> - Clflags.external_lib_deps_mode := x); - set_dirs c; - set_common_other ?log_file c ~targets - let footer = `Blocks [ `S "BUGS" diff --git a/bin/common.mli b/bin/common.mli index 4d7ac1f20fc..7b3a47d9c36 100644 --- a/bin/common.mli +++ b/bin/common.mli @@ -34,27 +34,10 @@ val prefix_target : t -> string -> string val instrument_with : t -> Dune_engine.Lib_name.t list option -(** [set_common ?log common ~targets ~external_lib_deps_mode] is - [set_dirs common] followed by [set_common_other common ~targets]. In - general, [set_common] executes sequence of side-effecting actions to - initialize Dune's working environment based on the options determined in a - [Common.t] record.contents. *) -val set_common : - ?log_file:Dune_util.Log.File.t - -> ?external_lib_deps_mode:bool - -> t - -> targets:Arg.Dep.t list - -> unit - -(** [set_common_other common ~targets] sets all stateful values dictated by - [common], except those accounted for by [set_dirs]. [targets] are used to - obtain external library dependency hints, if needed. *) -val set_common_other : - ?log_file:Dune_util.Log.File.t -> t -> targets:Arg.Dep.t list -> unit - -(** [set_dirs common] sets the workspace root and build directories, and makes - the root the current working directory *) -val set_dirs : t -> unit +(** [set_common] executes sequence of side-effecting actions to initialize + Dune's working environment based on the options determined in a [Common.t] + record.contents. *) +val set_common : ?log_file:Dune_util.Log.File.t -> t -> unit (** [examples \[("description", "dune cmd foo"); ...\]] is an [EXAMPLES] manpage section of enumerated examples illustrating how to run the documented diff --git a/bin/compute.ml b/bin/compute.ml index 60f5f89e7da..faf0e64850a 100644 --- a/bin/compute.ml +++ b/bin/compute.ml @@ -29,7 +29,7 @@ let term = & info [] ~docv:"INPUT" ~doc:"Use $(docv) as the input to the function.") in - Common.set_common common ~targets:[] ~external_lib_deps_mode:true; + Common.set_common common; let action = Scheduler.go ~common (fun () -> let open Fiber.O in diff --git a/bin/describe.ml b/bin/describe.ml index 54f0723a9a8..986fc0f6dce 100644 --- a/bin/describe.ml +++ b/bin/describe.ml @@ -302,7 +302,7 @@ let term = and+ context_name = Common.context_arg ~doc:"Build context to use." and+ format = Format.arg and+ lang = Lang.arg in - Common.set_common common ~targets:[] ~external_lib_deps_mode:false; + Common.set_common common; let what = What.parse what ~lang in Scheduler.go ~common (fun () -> let open Fiber.O in diff --git a/bin/exec.ml b/bin/exec.ml index 24c63cb4685..50d74edad63 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -43,7 +43,7 @@ let term = value & flag & info [ "no-build" ] ~doc:"don't rebuild target before executing") and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in - Common.set_common common ~targets:[ Arg.Dep.file prog ]; + Common.set_common common; let setup = Scheduler.go ~common (fun () -> Memo.Build.run (Import.Main.setup common)) in diff --git a/bin/external_lib_deps.ml b/bin/external_lib_deps.ml index 7603f4aa17c..902019f9754 100644 --- a/bin/external_lib_deps.ml +++ b/bin/external_lib_deps.ml @@ -1,188 +1,28 @@ -open Stdune +open! Stdune open Import -let pp_external_libs libs = - Pp.enumerate (Lib_name.Map.to_list libs) ~f:(fun (name, kind) -> - match (kind : Lib_deps_info.Kind.t) with - | Optional -> Pp.textf "%s (optional)" (Lib_name.to_string name) - | Required -> Pp.textf "%s" (Lib_name.to_string name)) - -let doc = "Print out external libraries needed to build the given targets." +let doc = "Removed command." let man = [ `S "DESCRIPTION" - ; `P {|Print out the external libraries needed to build the given targets.|} ; `P - {|The output of $(b,dune external-lib-deps @install) should be included - in what is written in your $(i,.opam) file.|} + "This subcommand used to print out anapproximate set of external \ + libraries that were required for building a given set of targets, \ + without running the build. While this feature was useful, over time the \ + quality of approximation had degraded and the cost of maintenance had \ + increased, so we decided to remove it.\n" ; `Blocks Common.help_secs ] let info = Term.info "external-lib-deps" ~doc ~man -let all_lib_deps ~request = - let targets = Build_system.static_deps_of_request request in - let rules = Build_system.rules_for_transitive_closure targets in - let lib_deps = - List.map rules ~f:(fun (rule : Dune_engine.Rule.t) -> - let deps = Lib_deps_info.lib_deps rule.action.build in - (rule, deps)) - in - let module Context_name = Dune_engine.Context_name in - let contexts = Build_system.contexts () in - List.fold_left lib_deps ~init:[] - ~f:(fun acc ((rule : Dune_engine.Rule.t), deps) -> - if Lib_name.Map.is_empty deps then - acc - else - match Path.Build.extract_build_context rule.dir with - | None -> acc - | Some (context, p) -> - let context = Context_name.of_string context in - (context, (p, deps)) :: acc) - |> Context_name.Map.of_list_multi - |> Context_name.Map.filteri ~f:(fun ctx _ -> - Context_name.Map.mem contexts ctx) - |> Context_name.Map.map - ~f:(Path.Source.Map.of_list_reduce ~f:Lib_deps_info.merge) - -let opam_install_command ?switch_name packages = - let cmd = - match switch_name with - | Some name -> Printf.sprintf "opam install --switch=%s" name - | None -> "opam install" - in - cmd :: packages |> String.concat ~sep:" " - -let run ~lib_deps ~by_dir ~setup ~only_missing ~sexp = - Dune_engine.Context_name.Map.foldi lib_deps ~init:false - ~f:(fun context_name lib_deps_by_dir acc -> - let lib_deps = - Path.Source.Map.values lib_deps_by_dir - |> List.fold_left ~init:Lib_name.Map.empty ~f:Lib_deps_info.merge - in - let sctx = - Dune_engine.Context_name.Map.find_exn setup.Import.Main.scontexts - context_name - in - let switch_name = - match (Super_context.context sctx).Context.kind with - | Default -> None - | Opam { switch; _ } -> Some switch - in - let internals = Super_context.internal_lib_names sctx in - let is_external name _kind = not (Lib_name.Set.mem internals name) in - let externals = Lib_name.Map.filteri lib_deps ~f:is_external in - if only_missing then ( - if by_dir || sexp then - User_error.raise - [ Pp.textf - "--only-missing cannot be used with --unstable-by-dir or --sexp" - ]; - let context = - List.find_exn setup.workspace.contexts ~f:(fun c -> - Dune_engine.Context_name.equal c.name context_name) - in - let missing = - Lib_name.Map.filteri externals ~f:(fun name _ -> - not (Findlib.available context.findlib name)) - in - if Lib_name.Map.is_empty missing then - acc - else if - Lib_name.Map.for_alli missing ~f:(fun _ kind -> - kind = Lib_deps_info.Kind.Optional) - then ( - User_message.prerr - (User_error.make - [ Pp.textf - "The following libraries are missing in the %s context:" - (Dune_engine.Context_name.to_string context_name) - ; pp_external_libs missing - ]); - false - ) else - let required_package_names = - Lib_name.Map.to_list missing - |> List.filter_map ~f:(fun (name, kind) -> - match (kind : Lib_deps_info.Kind.t) with - | Optional -> None - | Required -> Some (Lib_name.package_name name)) - |> Package.Name.Set.of_list |> Package.Name.Set.to_list - |> List.map ~f:Package.Name.to_string - in - User_message.prerr - (User_error.make - [ Pp.textf - "The following libraries are missing in the %s context:" - (Dune_engine.Context_name.to_string context_name) - ; pp_external_libs missing - ] - ~hints: - [ Dune_engine.Utils.pp_command_hint - (opam_install_command ?switch_name required_package_names) - ]); - true - ) else if sexp then ( - if not by_dir then - User_error.raise [ Pp.textf "--sexp requires --unstable-by-dir" ]; - let lib_deps_by_dir = - lib_deps_by_dir - |> Path.Source.Map.map ~f:(Lib_name.Map.filteri ~f:is_external) - |> Path.Source.Map.filter ~f:(fun m -> not (Lib_name.Map.is_empty m)) - in - let sexp = - Path.Source.Map.to_dyn Lib_deps_info.to_dyn lib_deps_by_dir - |> Sexp.of_dyn - in - Format.printf "%a@." Pp.to_fmt - (Sexp.pp - (List - [ Atom (Dune_engine.Context_name.to_string context_name); sexp ])); - acc - ) else ( - if by_dir then - User_error.raise - [ Pp.textf "--unstable-by-dir cannot be used without --sexp" ]; - User_message.print - (User_message.make - [ Pp.textf - "These are the external library dependencies in the %s \ - context:" - (Dune_engine.Context_name.to_string context_name) - ; pp_external_libs externals - ]); - acc - )) - let term = - let+ common = Common.term - and+ only_missing = - Arg.( - value & flag - & info [ "missing" ] ~doc:{|Only print out missing dependencies|}) - and+ targets = Arg.(non_empty & pos_all dep [] & Arg.info [] ~docv:"TARGET") - and+ by_dir = - Arg.( - value & flag - & info [ "unstable-by-dir" ] - ~doc: - {|Print dependencies per directory - (this feature is currently unstable)|}) - and+ sexp = - Arg.(value & flag & info [ "sexp" ] ~doc:{|Produce a s-expression output|}) - in - Common.set_common common ~targets:[] ~external_lib_deps_mode:true; - let setup, lib_deps = - Scheduler.go ~common (fun () -> - let open Fiber.O in - let+ setup = Memo.Build.run (Import.Main.setup common) in - let targets = Target.resolve_targets_exn common setup targets in - let request = Target.request targets in - let deps = all_lib_deps ~request in - (setup, deps)) - in - let failure = run ~by_dir ~setup ~lib_deps ~sexp ~only_missing in - if failure then raise Dune_util.Report_error.Already_reported + Term.ret + @@ let+ _ = Common.term + and+ _ = Arg.(value & flag & info [ "missing" ] ~doc:{|unused|}) + and+ _ = Arg.(value & pos_all dep [] & Arg.info [] ~docv:"TARGET") + and+ _ = Arg.(value & flag & info [ "unstable-by-dir" ] ~doc:{|unused|}) + and+ _ = Arg.(value & flag & info [ "sexp" ] ~doc:{|unused|}) in + `Error (false, "This subcommand is no longer implemented.") let command = (term, info) diff --git a/bin/import.ml b/bin/import.ml index 41856fea80e..f4eed9f1271 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -6,7 +6,6 @@ module Super_context = Dune_rules.Super_context module Context = Dune_rules.Context module Config = Dune_engine.Config module Lib_name = Dune_engine.Lib_name -module Lib_deps_info = Dune_rules.Lib_deps_info module Build_system = Dune_engine.Build_system module Findlib = Dune_rules.Findlib module Package = Dune_engine.Package diff --git a/bin/init.ml b/bin/init.ml index e80195b0e16..dca3dbfce89 100644 --- a/bin/init.ml +++ b/bin/init.ml @@ -209,7 +209,7 @@ let term = & opt (some (enum Component.Options.Project.Pkg.commands)) None & info [ "pkg" ] ~docv ~doc) in - Common.set_common common_term ~targets:[]; + Common.set_common common_term; let open Component in let context = Init_context.make path in let common : Options.Common.t = { name; libraries; pps } in diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index fd3618b271f..d7272fb31ae 100644 --- a/bin/install_uninstall.ml +++ b/bin/install_uninstall.ml @@ -377,7 +377,7 @@ let install_uninstall ~what = "Select context to install from. By default, install files from \ all defined contexts.") and+ sections = Sections.term in - Common.set_common ~log_file:No_log_file common ~targets:[]; + Common.set_common ~log_file:No_log_file common; Scheduler.go ~common (fun () -> let open Fiber.O in let* workspace = Memo.Build.run (Import.Main.scan_workspace common) in diff --git a/bin/installed_libraries.ml b/bin/installed_libraries.ml index 4a6d6912aa0..6be086e04cf 100644 --- a/bin/installed_libraries.ml +++ b/bin/installed_libraries.ml @@ -13,7 +13,7 @@ let term = & info [ "na"; "not-available" ] ~doc:"List libraries that are not available and explain why") in - Common.set_common common ~targets:[]; + Common.set_common common; let capture_outputs = Common.capture_outputs common in let _env : Env.t = Import.Main.setup_env ~capture_outputs in Scheduler.go ~common (fun () -> diff --git a/bin/ocaml_merlin.ml b/bin/ocaml_merlin.ml index e4ffae7de05..3716336441e 100644 --- a/bin/ocaml_merlin.ml +++ b/bin/ocaml_merlin.ml @@ -28,7 +28,7 @@ let term = debugging purposes only and should not be considered as a stable \ ouptut.") in - Common.set_common common ~log_file:No_log_file ~targets:[]; + Common.set_common common ~log_file:No_log_file; Dune_engine.File_tree.init ~recognize_jbuilder_projects:true ~ancestor_vcs:None; let x = Common.x common in @@ -69,7 +69,7 @@ module Dump_dot_merlin = struct "The path to the folder of which the configuration should be \ printed. Defaults to the current directory.") in - Common.set_common common ~log_file:No_log_file ~targets:[]; + Common.set_common common ~log_file:No_log_file; Dune_engine.File_tree.init ~recognize_jbuilder_projects:true ~ancestor_vcs:None; let x = Common.x common in diff --git a/bin/print_rules.ml b/bin/print_rules.ml index ee5148dd013..f12ac67379a 100644 --- a/bin/print_rules.ml +++ b/bin/print_rules.ml @@ -107,7 +107,7 @@ let term = the given targets.") and+ syntax = Syntax.term and+ targets = Arg.(value & pos_all dep [] & Arg.info [] ~docv:"TARGET") in - Common.set_common common ~targets ~external_lib_deps_mode:true; + Common.set_common common; let out = Option.map ~f:Path.of_string out in Scheduler.go ~common (fun () -> let open Fiber.O in diff --git a/bin/printenv.ml b/bin/printenv.ml index 0079b795b7a..9d2e197e084 100644 --- a/bin/printenv.ml +++ b/bin/printenv.ml @@ -46,7 +46,7 @@ let term = "Only print this field. This option can be repeated multiple times \ to print multiple fields.") in - Common.set_common common ~targets:[]; + Common.set_common common; Scheduler.go ~common (fun () -> let open Fiber.O in let* setup = Memo.Build.run (Import.Main.setup common) in diff --git a/bin/promote.ml b/bin/promote.ml index d35bc0a513e..126c903038b 100644 --- a/bin/promote.ml +++ b/bin/promote.ml @@ -22,7 +22,7 @@ let command = and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in - Common.set_common common ~targets:[]; + Common.set_common common; Promotion.promote_files_registered_in_last_run ( match files with | [] -> All diff --git a/bin/rpc.ml b/bin/rpc.ml index fa89eb392b6..1e08c725cc1 100644 --- a/bin/rpc.ml +++ b/bin/rpc.ml @@ -25,7 +25,7 @@ let wait_for_server common = loop () let client_term common f = - Common.set_common common ~targets:[] ~external_lib_deps_mode:false; + Common.set_common common; Scheduler.go ~common (fun () -> let where = wait_for_server common in f where) diff --git a/bin/top.ml b/bin/top.ml index 9edead67dfd..4dce9d8d88e 100644 --- a/bin/top.ml +++ b/bin/top.ml @@ -27,7 +27,7 @@ let term = and+ ctx_name = Common.context_arg ~doc:{|Select context where to build/run utop.|} in - Common.set_common common ~targets:[]; + Common.set_common common; Scheduler.go ~common (fun () -> let open Fiber.O in let* setup = Memo.Build.run (Import.Main.setup common) in diff --git a/bin/upgrade.ml b/bin/upgrade.ml index ddd6dd98c2d..92f29551b42 100644 --- a/bin/upgrade.ml +++ b/bin/upgrade.ml @@ -15,7 +15,7 @@ let info = Term.info "upgrade" ~doc ~man let term = let+ common = Common.term in - Common.set_common common ~targets:[]; + Common.set_common common; Scheduler.go ~common (fun () -> Dune_engine.File_tree.init ~recognize_jbuilder_projects:true ~ancestor_vcs:None; diff --git a/bin/utop.ml b/bin/utop.ml index 807540151e8..fb58b9549be 100644 --- a/bin/utop.ml +++ b/bin/utop.ml @@ -19,13 +19,12 @@ let term = and+ ctx_name = Common.context_arg ~doc:{|Select context where to build/run utop.|} and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in - Common.set_dirs common; + Common.set_common common; if not (Path.is_directory (Path.of_string (Common.prefix_target common dir))) then User_error.raise [ Pp.textf "cannot find directory: %s" (String.maybe_quoted dir) ]; let utop_target = Arg.Dep.file (Filename.concat dir Utop.utop_exe) in - Common.set_common_other common ~targets:[ utop_target ]; let sctx, utop_path = Scheduler.go ~common (fun () -> let open Fiber.O in diff --git a/src/dune_engine/action_builder.ml b/src/dune_engine/action_builder.ml index 312e75d43da..aa43cf64df8 100644 --- a/src/dune_engine/action_builder.ml +++ b/src/dune_engine/action_builder.ml @@ -1,8 +1,6 @@ open! Stdune open Import -type label = .. - module T = struct type 'a t = | Pure : 'a -> 'a t @@ -18,7 +16,6 @@ module T = struct | Lines_of : Path.t -> string list t | Dyn_paths : ('a * Path.Set.t) t -> 'a t | Dyn_deps : ('a * Dep.Set.t) t -> 'a t - | Label : label -> unit t | Or_exn : 'a Or_exn.t t -> 'a t | Fail : fail -> _ t | Memo : 'a memo -> 'a t @@ -75,8 +72,6 @@ let all_unit xs = let+ (_ : unit list) = all xs in () -let label map = Label map - let deps d = Deps d let dep d = Deps (Dep.Set.singleton d) @@ -331,7 +326,6 @@ end = struct { Static_deps.empty with rule_deps = Dep.Set.of_files [ p ] } | Lines_of p -> { Static_deps.empty with rule_deps = Dep.Set.of_files [ p ] } - | Label _ -> Static_deps.empty | Or_exn _ -> Static_deps.empty | Fail _ -> Static_deps.empty | Memo m -> Memo.exec memo (Input.T m) @@ -344,49 +338,6 @@ end let static_deps = Analysis.static_deps -(* We do no memoization in this function because it is currently used only to - support the [external-lib-deps] command and so it's not on the critical path. *) -let fold_labeled (type acc) t ~(init : acc) ~f = - let file_exists = Fdecl.get file_exists_fdecl in - let rec loop : type a. a t -> acc -> acc = - fun t acc -> - match t with - | Pure _ -> acc - | Map (_, a) -> loop a acc - | Both (a, b) -> - let acc = loop a acc in - loop b acc - | Seq (a, b) -> - let acc = loop a acc in - loop b acc - | Map2 (_, a, b) -> - let acc = loop a acc in - loop b acc - | All xs -> List.fold_left xs ~init:acc ~f:(fun acc a -> loop a acc) - | Paths_for_rule _ -> acc - | Paths_glob _ -> acc - | Deps _ -> acc - | Dyn_paths t -> loop t acc - | Dyn_deps t -> loop t acc - | Contents _ -> acc - | Lines_of _ -> acc - | Label r -> f r acc - | Or_exn _ -> acc - | Fail _ -> acc - | If_file_exists (p, then_, else_) -> - if file_exists p then - loop then_ acc - else - loop else_ acc - | Memo m -> loop m.t acc - | Catch (t, _) -> loop t acc - | Memo_build _ -> acc - | Dyn_memo_build b -> loop b acc - | Build b -> loop b acc - | Capture_deps b -> loop b acc - in - loop t init - (* Execution *) module Expert = struct @@ -466,7 +417,6 @@ struct | Dyn_deps t -> let+ (x, dyn_deps), dyn_deps_x = exec t in (x, Dep.Set.union dyn_deps dyn_deps_x) - | Label _ -> Memo.Build.return ((), Dep.Set.empty) | Or_exn e -> let+ a, deps = exec e in (Result.ok_exn a, deps) @@ -540,7 +490,6 @@ let rec can_eval_statically : type a. a t -> bool = function | Dyn_deps b -> can_eval_statically b | Contents _ -> false | Lines_of _ -> false - | Label _ -> true | Or_exn b -> can_eval_statically b | Fail _ -> true | If_file_exists (_, _, _) -> false @@ -611,7 +560,6 @@ let static_eval = (x, Deps deps >>> acc) | Contents _ -> assert false | Lines_of _ -> assert false - | Label _ -> ((), acc >>> t) | Or_exn b -> let res, acc = loop b acc in (Result.ok_exn res, acc) diff --git a/src/dune_engine/action_builder.mli b/src/dune_engine/action_builder.mli index 0722b735820..9ce78565ae1 100644 --- a/src/dune_engine/action_builder.mli +++ b/src/dune_engine/action_builder.mli @@ -3,9 +3,6 @@ open! Stdune open! Import -(** Type of values allowed to be labeled *) -type label = .. - type 'a t include Applicative_intf.S1 with type 'a t := 'a t @@ -200,16 +197,11 @@ val create_file : Path.Build.t -> Action.t With_targets.t (** Merge a list of actions accumulating the sets of their targets. *) val progn : Action.t With_targets.t list -> Action.t With_targets.t -val label : label -> unit t - (** {1 Analysis} *) (** Compute static dependencies of an action builder. *) val static_deps : _ t -> Static_deps.t -(** Compute static library dependencies of an action builder. *) -val fold_labeled : _ t -> init:'acc -> f:(label -> 'acc -> 'acc) -> 'acc - (** Returns [Some (x, t)] if the following can be evaluated statically. The returned [t] should be attached to the current action builder to record dependencies and other informations. Otherwise return [None]. *) diff --git a/src/dune_engine/clflags.ml b/src/dune_engine/clflags.ml index bc0739a3d49..cab668244ef 100644 --- a/src/dune_engine/clflags.ml +++ b/src/dune_engine/clflags.ml @@ -10,10 +10,6 @@ let debug_dep_path = ref false let debug_artifact_substitution = ref false -let external_lib_deps_hint = ref [] - -let external_lib_deps_mode = ref false - let capture_outputs = ref true let debug_backtraces = Dune_util.Report_error.report_backtraces diff --git a/src/dune_engine/clflags.mli b/src/dune_engine/clflags.mli index ef79238f4d8..6e79daad435 100644 --- a/src/dune_engine/clflags.mli +++ b/src/dune_engine/clflags.mli @@ -6,11 +6,6 @@ val debug_dep_path : bool ref (** Debug the findlib implementation *) val debug_findlib : bool ref -(** The command line for "Hint: try: dune external-lib-deps ..." *) -val external_lib_deps_hint : string list ref - -val external_lib_deps_mode : bool ref - (** Capture the output of sub-commands *) val capture_outputs : bool ref diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 23131310658..4dda89be235 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -1,6 +1,5 @@ open! Dune_engine open Stdune -open Action_builder.O let gen_select_rules t ~dir compile_info = List.iter (Lib.Compile.resolved_selects compile_info) ~f:(fun rs -> @@ -16,16 +15,12 @@ let gen_select_rules t ~dir compile_info = |> Action_builder.with_targets ~targets:[ dst ] )) let with_lib_deps (t : Context.t) compile_info ~dir ~f = - let prefix = - Action_builder.label - (Lib_deps_info.Label (Lib.Compile.lib_deps_info compile_info)) - in let prefix = if t.merlin then Merlin_ident.merlin_exists_path dir (Lib.Compile.merlin_ident compile_info) - |> Path.build |> Action_builder.path >>> prefix + |> Path.build |> Action_builder.path else - prefix + Action_builder.return () in Build_system.prefix_rules prefix ~f diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 83ce75ec422..50c105bdf81 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -78,7 +78,7 @@ let gen_rules sctx t ~dir ~scope = let obj_dir = Obj_dir.make_exe ~dir:cinaps_dir ~name in let expander = Super_context.expander sctx ~dir in let preprocess = - Preprocessing.make sctx ~dir ~expander ~dep_kind:Required + Preprocessing.make sctx ~dir ~expander ~lint:(Preprocess.Per_module.no_preprocessing ()) ~preprocess:t.preprocess ~preprocessor_deps:t.preprocessor_deps ~instrumentation_deps:[] ~lib_name:None ~scope @@ -93,7 +93,7 @@ let gen_rules sctx t ~dir ~scope = [ (t.loc, name) ] (Lib_dep.Direct (loc, Lib_name.of_string "cinaps.runtime") :: t.libraries) ~pps:(Preprocess.Per_module.pps t.preprocess) - ~dune_version ~optional:false + ~dune_version in let cctx = Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml index 70b3cd3fe84..1bbf4b1734b 100644 --- a/src/dune_rules/dep_conf_eval.ml +++ b/src/dune_rules/dep_conf_eval.ml @@ -129,7 +129,6 @@ let dep expander = function let dep expander x = Action_builder.of_result (dep expander x) let prepare_expander expander = - let expander = Expander.set_dep_kind expander Optional in Expander.set_expanding_what expander Deps_like_field let unnamed ~expander l = diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 7f0f144194d..36fbdd8d046 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -110,17 +110,6 @@ module Lib_deps = struct t let of_pps pps = List.map pps ~f:(fun pp -> Lib_dep.direct (Loc.none, pp)) - - let info t ~kind = - List.concat_map t ~f:(function - | Lib_dep.Re_export (_, s) - | Direct (_, s) -> - [ (s, kind) ] - | Select { choices; _ } -> - List.concat_map choices ~f:(fun (c : Lib_dep.Select.Choice.t) -> - Lib_name.Set.to_list c.required - |> List.map ~f:(fun d -> (d, Lib_deps_info.Kind.Optional)))) - |> Lib_name.Map.of_list_reduce ~f:Lib_deps_info.Kind.merge end let preprocess_fields = diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index eb302606e87..4e287d588cb 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -28,8 +28,6 @@ module Lib_deps : sig val of_pps : Lib_name.t list -> t - val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t - val decode : for_ -> t Dune_lang.Decoder.t end diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index 7722a2baa6f..6a01260f563 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -2,7 +2,6 @@ module Main = Main module Context = Context module Super_context = Super_context module Findlib = Findlib -module Lib_deps_info = Lib_deps_info module Colors = Colors module Profile = Profile module Workspace = Workspace diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 534f9832ef1..5c5770e4cfe 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -125,7 +125,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info Preprocess.Per_module.instrumentation_deps exes.buildable.preprocess ~instrumentation_backend in - Preprocessing.make sctx ~dir ~dep_kind:Required ~scope ~expander ~preprocess + Preprocessing.make sctx ~dir ~scope ~expander ~preprocess ~preprocessor_deps:exes.buildable.preprocessor_deps ~instrumentation_deps ~lint:exes.buildable.lint ~lib_name:None in @@ -223,7 +223,7 @@ let compile_info ~scope (exes : Dune_file.Executables.t) = Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) exes.names exes.buildable.libraries ~pps ~dune_version ~allow_overlaps:exes.buildable.allow_overlapping_dependencies - ~optional:exes.optional ~forbidden_libraries:exes.forbidden_libraries + ~forbidden_libraries:exes.forbidden_libraries let rules ~sctx ~dir ~dir_contents ~scope ~expander (exes : Dune_file.Executables.t) = diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index 7e13d3418d2..7a777be9f53 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -30,7 +30,6 @@ type t = ; foreign_flags : dir:Path.Build.t -> string list Action_builder.t Foreign_language.Dict.t ; find_package : Package.Name.t -> any_package option - ; dep_kind : Lib_deps_info.Kind.t ; expanding_what : Expanding_what.t } @@ -57,8 +56,6 @@ let set_artifacts_dynamic t artifacts_dynamic = { t with artifacts_dynamic } let set_lookup_ml_sources t ~f = { t with lookup_artifacts = Some f } -let set_dep_kind t dep_kind = { t with dep_kind } - let set_expanding_what t x = { t with expanding_what = x } let map_exe t p = @@ -198,10 +195,6 @@ type nonrec expansion_result = let static v = Direct (Action_builder.return v) -let lib_dep t ?(dep_kind = t.dep_kind) lib = - Action_builder.label - (Lib_deps_info.Label (Lib_name.Map.singleton lib dep_kind)) - let[@inline never] invalid_use_of_target_variable t ~(source : Dune_lang.Template.Pform.t) ~var_multiplicity = match t.expanding_what with @@ -399,8 +392,6 @@ let expand_pform_gen ~(context : Context.t) ~bindings ~dir ~source else t.scope in - lib_dep t lib - >>> match if lib_private then let open Result.O in @@ -488,9 +479,9 @@ let expand_pform_gen ~(context : Context.t) ~bindings ~dir ~source let lib = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, s) in - let+ () = lib_dep t lib ~dep_kind:Optional in - Lib.DB.available (Scope.libs t.scope) lib - |> string_of_bool |> string) + Action_builder.return + ( Lib.DB.available (Scope.libs t.scope) lib + |> string_of_bool |> string )) | Read -> let path = relative ~source dir s in Direct (Action_builder.map (Action_builder.contents path) ~f:string) @@ -546,7 +537,6 @@ let make ~scope ~scope_host ~(context : Context.t) ~lib_artifacts Code_error.raise "foreign flags expander is not set" [ ("dir", Path.Build.to_dyn dir) ]) ; find_package - ; dep_kind = Required ; expanding_what = Nothing_special } diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index 0dc1689aa3f..babce6387e3 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -54,8 +54,6 @@ val set_artifacts_dynamic : t -> bool -> t val set_lookup_ml_sources : t -> f:(dir:Path.Build.t -> Ml_sources.Artifacts.t) -> t -val set_dep_kind : t -> Lib_deps_info.Kind.t -> t - module Expanding_what : sig type t = | Nothing_special diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 0e7fd91026a..705fb1107eb 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -69,8 +69,8 @@ let gen_rules_output sctx (config : Format_config.t) ~version ~dialects in let open Action_builder.With_targets.O in Action_builder.with_no_targets extra_deps - >>> Preprocessing.action_for_pp ~dep_kind:Lib_deps_info.Kind.Required - ~loc ~expander ~action ~src ~target:(Some output) + >>> Preprocessing.action_for_pp ~loc ~expander ~action ~src + ~target:(Some output) in Option.iter formatter ~f:(fun arr -> Super_context.add_rule sctx ~mode:Standard ~loc ~dir arr; diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 58ca9df04a1..b56619d6899 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -199,12 +199,7 @@ end = struct ; List.map ~f:(make_entry Lib) install_c_headers ] - let keep_if ~external_lib_deps_mode expander = - if external_lib_deps_mode then - fun ~scope:_ -> - Option.some - else - fun ~scope stanza -> + let keep_if expander ~scope stanza = Option.some_if ( match (stanza : Stanza.t) with | Dune_file.Library lib -> @@ -232,7 +227,6 @@ end = struct Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) exes.names exes.buildable.libraries ~pps ~dune_version ~allow_overlaps:exes.buildable.allow_overlapping_dependencies - ~optional:exes.optional in Result.is_ok (Lib.Compile.direct_requires compile_info) ) | Coq_stanza.Theory.T d -> Option.is_some d.package @@ -302,10 +296,6 @@ end = struct else acc)) in - let keep_if = - let external_lib_deps_mode = !Clflags.external_lib_deps_mode in - keep_if ~external_lib_deps_mode - in Dir_with_dune.deep_fold stanzas ~init ~f:(fun d stanza acc -> let { Dir_with_dune.ctx_dir = dir; scope; _ } = d in let expander = Super_context.expander sctx ~dir in diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 4a75523f7d4..f288eea2df0 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -33,19 +33,8 @@ module Error = struct | [] -> info | _ -> Pp.vbox (Pp.concat ~sep:Pp.cut [ info; Dep_path.Entries.pp dp ]) - let external_lib_deps_hint () = - match !Clflags.external_lib_deps_hint with - | [] -> [] - | l -> - [ l - |> List.map ~f:String.quote_for_shell - |> String.concat ~sep:" " |> Utils.pp_command_hint - ] - let not_found ~loc ~name = - make ~loc - [ Pp.textf "Library %S not found." (Lib_name.to_string name) ] - ~hints:(external_lib_deps_hint ()) + make ~loc [ Pp.textf "Library %S not found." (Lib_name.to_string name) ] let hidden ~loc ~name ~dir ~reason = make ~loc @@ -53,7 +42,6 @@ module Error = struct (Path.to_string_maybe_quoted dir) reason ] - ~hints:(external_lib_deps_hint ()) (* diml: it is not very clear what a "default implementation cycle" is *) let default_implementation_cycle cycle = @@ -1650,18 +1638,11 @@ module Compile = struct ; requires_link : t list Or_exn.t Lazy.t ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list - ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t ; merlin_ident : Merlin_ident.t } - let make_lib_deps_info ~user_written_deps ~pps ~kind = - Lib_deps_info.merge - (Dune_file.Lib_deps.info user_written_deps ~kind) - ( List.map pps ~f:(fun (_, pp) -> (pp, kind)) - |> Lib_name.Map.of_list_reduce ~f:Lib_deps_info.Kind.merge ) - - let for_lib resolve ~allow_overlaps db (t : lib) = + let for_lib ~allow_overlaps db (t : lib) = let requires = (* This makes sure that the default implementation belongs to the same package before we build the virtual library *) @@ -1674,25 +1655,6 @@ module Compile = struct in t.requires in - let lib_deps_info = - let pps = - let resolve = resolve db in - Preprocess.Per_module.pps - (Preprocess.Per_module.with_instrumentation - (Lib_info.preprocess t.info) - ~instrumentation_backend: - (instrumentation_backend ~do_not_fail:true db.instrument_with - resolve)) - in - let user_written_deps = Lib_info.user_written_deps t.info in - let kind : Lib_deps_info.Kind.t = - let enabled = Lib_info.enabled t.info in - match enabled with - | Normal -> Required - | _ -> Optional - in - make_lib_deps_info ~user_written_deps ~pps ~kind - in let requires_link = let db = Option.some_if (not allow_overlaps) db in lazy @@ -1705,7 +1667,6 @@ module Compile = struct ; requires_link ; resolved_selects = t.resolved_selects ; pps = t.pps - ; lib_deps_info ; sub_systems = t.sub_systems ; merlin_ident } @@ -1718,8 +1679,6 @@ module Compile = struct let pps t = t.pps - let lib_deps_info t = t.lib_deps_info - let merlin_ident t = t.merlin_ident let sub_systems t = @@ -1791,12 +1750,7 @@ module DB = struct | Error e -> ( match e with | Invalid_dune_package why -> Invalid why - | Not_found -> - if !Clflags.external_lib_deps_mode then - let pkg = Findlib.dummy_lib findlib ~name in - Found (Dune_package.Lib.info pkg) - else - Not_found )) + | Not_found -> Not_found )) ~all:(fun () -> Findlib.all_packages findlib |> List.map ~f:Dune_package.Entry.name) @@ -1840,18 +1794,10 @@ module DB = struct | None -> Code_error.raise "Lib.DB.get_compile_info got library that doesn't exist" [ ("name", Lib_name.to_dyn name) ] - | Some lib -> Compile.for_lib resolve ~allow_overlaps t lib + | Some lib -> Compile.for_lib ~allow_overlaps t lib let resolve_user_written_deps_for_exes t exes ?(allow_overlaps = false) - ?(forbidden_libraries = []) deps ~pps ~dune_version ~optional = - let lib_deps_info = - Compile.make_lib_deps_info ~user_written_deps:deps ~pps - ~kind: - ( if optional then - Optional - else - Required ) - in + ?(forbidden_libraries = []) deps ~pps ~dune_version = let { Resolve.requires = res ; pps ; selects = resolved_selects @@ -1888,7 +1834,6 @@ module DB = struct ; requires_link ; pps ; resolved_selects - ; lib_deps_info ; sub_systems = Sub_system_name.Map.empty ; merlin_ident } diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 0f72ac5110e..1575b717b1b 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -140,8 +140,6 @@ module Compile : sig (** Transitive closure of all used ppx rewriters *) val pps : t -> L.t Or_exn.t - val lib_deps_info : t -> Lib_deps_info.t - val merlin_ident : t -> Merlin_ident.t (** Sub-systems used in this compilation context *) @@ -225,7 +223,6 @@ module DB : sig -> Lib_dep.t list -> pps:(Loc.t * Lib_name.t) list -> dune_version:Dune_lang.Syntax.Version.t - -> optional:bool -> Compile.t val resolve_pps : t -> (Loc.t * Lib_name.t) list -> L.t Or_exn.t diff --git a/src/dune_rules/lib_deps_info.ml b/src/dune_rules/lib_deps_info.ml deleted file mode 100644 index 8ea65ce7a06..00000000000 --- a/src/dune_rules/lib_deps_info.ml +++ /dev/null @@ -1,46 +0,0 @@ -open! Stdune -open Dune_engine - -module Kind = struct - type t = - | Optional - | Required - - let merge a b = - match (a, b) with - | Optional, Optional -> Optional - | _ -> Required - - let of_optional b = - if b then - Optional - else - Required - - let to_dyn t = - Dyn.String - ( match t with - | Optional -> "optional" - | Required -> "required" ) -end - -type t = Kind.t Lib_name.Map.t - -let merge a b = - Lib_name.Map.merge a b ~f:(fun _ a b -> - match (a, b) with - | None, None -> None - | x, None - | None, x -> - x - | Some a, Some b -> Some (Kind.merge a b)) - -let to_dyn = Lib_name.Map.to_dyn Kind.to_dyn - -type Action_builder.label += Label of t - -let lib_deps t : t = - Action_builder.fold_labeled t ~init:Lib_name.Map.empty ~f:(fun r acc -> - match r with - | Label u -> merge u acc - | _ -> acc) diff --git a/src/dune_rules/lib_deps_info.mli b/src/dune_rules/lib_deps_info.mli deleted file mode 100644 index 851beaa7678..00000000000 --- a/src/dune_rules/lib_deps_info.mli +++ /dev/null @@ -1,27 +0,0 @@ -(** Tracking of library dependencies *) - -(** This module implements tracking of external library dependencies, for - [dune external-lib-deps] *) - -open! Stdune -open Dune_engine - -module Kind : sig - type t = - | Optional - | Required - - val merge : t -> t -> t - - val of_optional : bool -> t -end - -type t = Kind.t Lib_name.Map.t - -val merge : t -> t -> t - -val to_dyn : t -> Dyn.t - -type Action_builder.label += Label of t - -val lib_deps : _ Action_builder.t -> t diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 482a391310a..f77b92268c7 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -334,12 +334,6 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = - let dep_kind = - if lib.optional then - Lib_deps_info.Kind.Optional - else - Required - in let flags = Super_context.ocaml_flags sctx ~dir lib.buildable.flags in let obj_dir = Library.obj_dir ~dir lib in let vimpl = Virtual_rules.impl sctx ~lib ~scope in @@ -357,7 +351,7 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope in (* Preprocess before adding the alias module as it doesn't need preprocessing *) let pp = - Preprocessing.make sctx ~dir ~dep_kind ~scope ~preprocess ~expander + Preprocessing.make sctx ~dir ~scope ~preprocess ~expander ~preprocessor_deps:lib.buildable.preprocessor_deps ~instrumentation_deps ~lint:lib.buildable.lint ~lib_name:(Some (snd lib.name)) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index be1259e16fb..857a8e500b1 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -283,7 +283,6 @@ module Unprocessed = struct Forbidden "preprocessing actions" in let action = Preprocessing.chdir (Run (exe, args)) in - let expander = Expander.set_dep_kind expander Optional in Action_unexpanded.expand ~loc ~expander ~deps:[] ~targets ~targets_dir action in diff --git a/src/dune_rules/preprocessing.ml b/src/dune_rules/preprocessing.ml index 84b284350e6..c35c2045920 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -465,7 +465,7 @@ let promote_correction fn build ~suffix = let chdir action = Action_unexpanded.Chdir (workspace_root_var, action) -let action_for_pp ~dep_kind ~loc ~expander ~action ~src ~target = +let action_for_pp ~loc ~expander ~action ~src ~target = let action = chdir action in let bindings = Pform.Map.singleton (Var Input_file) [ Value.Path (Path.build src) ] @@ -474,7 +474,6 @@ let action_for_pp ~dep_kind ~loc ~expander ~action ~src ~target = let targets = Targets.Or_forbidden.Forbidden "preprocessing actions" in let targets_dir = Option.value ~default:src target |> Path.Build.parent_exn in let action = - let expander = Expander.set_dep_kind expander dep_kind in let open Action_builder.With_targets.O in Action_builder.with_no_targets (Action_builder.path (Path.build src)) >>> Action_unexpanded.expand action ~loc ~expander ~deps:[] ~targets @@ -489,7 +488,7 @@ let action_for_pp ~dep_kind ~loc ~expander ~action ~src ~target = (* Generate rules for the dialect modules in [modules] and return a a new module with only OCaml sources *) -let setup_dialect_rules sctx ~dir ~dep_kind ~expander (m : Module.t) = +let setup_dialect_rules sctx ~dir ~expander (m : Module.t) = let ml = Module.ml_source m in Module.iter m ~f:(fun ml_kind f -> match Dialect.preprocess f.dialect ml_kind with @@ -500,8 +499,7 @@ let setup_dialect_rules sctx ~dir ~dep_kind ~expander (m : Module.t) = Option.value_exn (Module.file ml ~ml_kind) |> Path.as_in_build_dir_exn in SC.add_rule sctx ~dir - (action_for_pp ~dep_kind ~loc ~expander ~action ~src - ~target:(Some dst))); + (action_for_pp ~loc ~expander ~action ~src ~target:(Some dst))); ml let add_corrected_suffix_binding expander suffix = @@ -519,7 +517,7 @@ let driver_flags expander ~flags ~corrected_suffix ~driver_flags ~standard = in (ppx_flags, args) -let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope = +let lint_module sctx ~dir ~expander ~lint ~lib_name ~scope = Staged.stage (let alias = Alias.lint ~dir in let add_alias fn build = @@ -536,8 +534,7 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope = Module.iter source ~f:(fun _ (src : Module.File.t) -> let src = Path.as_in_build_dir_exn src.path in add_alias src ~loc:(Some loc) - (action_for_pp ~dep_kind ~loc ~expander ~action ~src - ~target:None)) + (action_for_pp ~loc ~expander ~action ~src ~target:None)) | Pps { loc; pps; flags; staged } -> if staged then User_error.raise ~loc @@ -578,7 +575,7 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope = fun ~(source : Module.t) ~ast -> Module_name.Per_item.get lint (Module.name source) ~source ~ast) -let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps +let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps ~instrumentation_deps ~lib_name ~scope = let preprocessor_deps = preprocessor_deps @ instrumentation_deps in let preprocess = @@ -591,14 +588,13 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps |> Action_builder.memoize "preprocessor deps" in let lint_module = - Staged.unstage - (lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope) + Staged.unstage (lint_module sctx ~dir ~expander ~lint ~lib_name ~scope) in Module_name.Per_item.map preprocess ~f:(fun pp -> match pp with | No_preprocessing -> fun m ~lint -> - let ast = setup_dialect_rules sctx ~dir ~dep_kind ~expander m in + let ast = setup_dialect_rules sctx ~dir ~expander m in if lint then lint_module ~ast ~source:m; ast | Action (loc, action) -> @@ -606,13 +602,12 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps let ast = pped_module m ~f:(fun _kind src dst -> let action = - action_for_pp ~dep_kind ~loc ~expander ~action ~src - ~target:(Some dst) + action_for_pp ~loc ~expander ~action ~src ~target:(Some dst) in let open Action_builder.With_targets.O in SC.add_rule sctx ~loc ~dir (Action_builder.with_no_targets preprocessor_deps >>> action)) - |> setup_dialect_rules sctx ~dir ~dep_kind ~expander + |> setup_dialect_rules sctx ~dir ~expander in if lint then lint_module ~ast ~source:m; ast @@ -634,7 +629,7 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps in fun m ~lint -> let open Action_builder.With_targets.O in - let ast = setup_dialect_rules sctx ~dir ~dep_kind ~expander m in + let ast = setup_dialect_rules sctx ~dir ~expander m in if lint then lint_module ~ast ~source:m; pped_module ast ~f:(fun ml_kind src dst -> SC.add_rule ~sandbox:Sandbox_config.no_special_requirements sctx @@ -690,7 +685,7 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess ~preprocessor_deps in let pp = Some pp_flags in fun m ~lint -> - let ast = setup_dialect_rules sctx ~dir ~dep_kind ~expander m in + let ast = setup_dialect_rules sctx ~dir ~expander m in if lint then lint_module ~ast ~source:m; Module.set_pp ast pp) |> Pp_spec.make diff --git a/src/dune_rules/preprocessing.mli b/src/dune_rules/preprocessing.mli index 1c16783f394..c8bc3dcf79e 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -8,7 +8,6 @@ val make : Super_context.t -> dir:Path.Build.t -> expander:Expander.t - -> dep_kind:Lib_deps_info.Kind.t -> lint:Preprocess.Without_instrumentation.t Preprocess.Per_module.t -> preprocess:Preprocess.Without_instrumentation.t Preprocess.Per_module.t -> preprocessor_deps:Dep_conf.t list @@ -33,8 +32,7 @@ val gen_rules : Super_context.t -> string list -> unit val chdir : Action_unexpanded.t -> Action_unexpanded.t val action_for_pp : - dep_kind:Lib_deps_info.Kind.t - -> loc:Loc.t + loc:Loc.t -> expander:Expander.t -> action:Action_unexpanded.t -> src:Path.Build.t diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index f9d98c52d98..f0103dea0a0 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -443,7 +443,6 @@ let get_installed_binaries stanzas ~(context : Context.t) = Lib.DB.resolve_user_written_deps_for_exes (Scope.libs d.scope) exes.names exes.buildable.libraries ~pps ~dune_version ~allow_overlaps:exes.buildable.allow_overlapping_dependencies - ~optional:exes.optional in let available = Result.is_ok (Lib.Compile.direct_requires compile_info) diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml index 2fdb285dcfc..021cf35672c 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -155,9 +155,9 @@ module Stanza = struct in let preprocess = Module_name.Per_item.for_all toplevel.pps in let preprocessing = - Preprocessing.make sctx ~dir ~expander ~scope ~dep_kind:Required - ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess - ~preprocessor_deps:[] ~instrumentation_deps:[] + Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None + ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] + ~instrumentation_deps:[] in let compile_info = let compiler_libs = @@ -167,7 +167,7 @@ module Stanza = struct [ (source.loc, source.name) ] ( Lib_dep.Direct (source.loc, compiler_libs) :: List.map toplevel.libraries ~f:(fun d -> Lib_dep.Direct d) ) - ~pps ~dune_version ~allow_overlaps:false ~optional:false + ~pps ~dune_version ~allow_overlaps:false in let requires_compile = Lib.Compile.direct_requires compile_info in let requires_link = Lib.Compile.requires_link compile_info in diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 0048f4bc177..17b4215a376 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -82,9 +82,9 @@ let setup sctx ~dir = in let preprocess = Module_name.Per_item.for_all pps in let preprocessing = - Preprocessing.make sctx ~dir ~expander ~scope ~dep_kind:Required - ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess - ~preprocessor_deps:[] ~instrumentation_deps:[] + Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None + ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] + ~instrumentation_deps:[] in let source = source ~dir in let obj_dir = Toplevel.Source.obj_dir source in diff --git a/test/blackbox-tests/test-cases/deprecated-library-name/features.t b/test/blackbox-tests/test-cases/deprecated-library-name/features.t index 038dde46974..425890e8732 100644 --- a/test/blackbox-tests/test-cases/deprecated-library-name/features.t +++ b/test/blackbox-tests/test-cases/deprecated-library-name/features.t @@ -95,8 +95,6 @@ that wasn't found: 1 | (executable (name prog) (libraries a)) ^ Error: Library "a" not found. - Hint: try: - dune external-lib-deps --missing c/prog.exe [1] Test that we can migrate top-level libraries diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-context_name.t/run.t b/test/blackbox-tests/test-cases/enabled_if/eif-context_name.t/run.t index 471d4bf2ffb..82ac65090f6 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-context_name.t/run.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-context_name.t/run.t @@ -29,8 +29,6 @@ dune >= 2.8 18 | (libraries bar)) ^^^ Error: Library "bar" in _build/default is hidden (unsatisfied 'enabled_if'). - Hint: try: - dune external-lib-deps --missing ./bar_exe.exe [1] + The actual context diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-ocaml_version.t/run.t b/test/blackbox-tests/test-cases/enabled_if/eif-ocaml_version.t/run.t index 4e03c1a7f28..9c7bff8c18c 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-ocaml_version.t/run.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-ocaml_version.t/run.t @@ -10,6 +10,4 @@ This one is disabled (version too low) ^^^^^^^^^^ Error: Library "futurecaml" in _build/default is hidden (unsatisfied 'enabled_if'). - Hint: try: - dune external-lib-deps --missing main2.exe [1] diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/run.t b/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/run.t index 425721d8142..dbb5aaf3bf3 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/run.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/run.t @@ -28,8 +28,6 @@ Test the enabled_if field for libraries: 35 | (libraries foo)) ^^^ Error: Library "foo" in _build/default is hidden (unsatisfied 'enabled_if'). - Hint: try: - dune external-lib-deps --missing main.exe [1] Ideally, the above message should mention the dependency path between diff --git a/test/blackbox-tests/test-cases/exec-missing.t/run.t b/test/blackbox-tests/test-cases/exec-missing.t/run.t index 582afad4ee2..ace69a61bd4 100644 --- a/test/blackbox-tests/test-cases/exec-missing.t/run.t +++ b/test/blackbox-tests/test-cases/exec-missing.t/run.t @@ -5,6 +5,4 @@ When using dune exec, the external-lib-deps command refers to the executable: 3 | (libraries does-not-exist)) ^^^^^^^^^^^^^^ Error: Library "does-not-exist" not found. - Hint: try: - dune external-lib-deps --missing ./x.exe [1] diff --git a/test/blackbox-tests/test-cases/external-lib-deps.t b/test/blackbox-tests/test-cases/external-lib-deps.t new file mode 100644 index 00000000000..1ba689c12eb --- /dev/null +++ b/test/blackbox-tests/test-cases/external-lib-deps.t @@ -0,0 +1,5 @@ +external-lib-deps is no more. + + $ dune external-lib-deps + dune external-lib-deps: This subcommand is no longer implemented. + [1] diff --git a/test/blackbox-tests/test-cases/external-lib-deps/github3143.t/run.t b/test/blackbox-tests/test-cases/external-lib-deps/github3143.t/run.t deleted file mode 100644 index 2b4cbf68d1a..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/github3143.t/run.t +++ /dev/null @@ -1,13 +0,0 @@ -Reproduce #3143 - - $ echo "(lang dune 2.3)" > dune-project - $ touch dummypkg.opam - $ cat >dune < (library - > (public_name dummypkg) - > (libraries base doesnotexist.foo)) - > EOF - $ dune external-lib-deps @install - These are the external library dependencies in the default context: - - base - - doesnotexist.foo diff --git a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune b/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune deleted file mode 100644 index 1df0d1f3669..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune +++ /dev/null @@ -1,18 +0,0 @@ -(library - (name foo) - (modules :standard \ prog) - (libraries a________ b________ c________) - (preprocess (pps d________ e________ f________))) - -(rule - (with-stdout-to file.ml - (echo %{lib-available:optional}))) - -(rule (with-stdout-to foo.ml (run prog))) - -(executable - (name prog) - (modules prog) - (libraries h________ i________ j________)) - -(rule (with-stdout-to prog.ml (echo ""))) diff --git a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune-project b/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune-project deleted file mode 100644 index 4def4fa3e65..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/dune-project +++ /dev/null @@ -1,4 +0,0 @@ -(lang dune 1.9) -(name foo) - -(allow_approximate_merlin true) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/run.t b/test/blackbox-tests/test-cases/external-lib-deps/missing.t/run.t deleted file mode 100644 index 4687325856f..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/missing.t/run.t +++ /dev/null @@ -1,17 +0,0 @@ -Expected: Only required packages are hinted, and no wrapping occurs in the install command. - - $ dune external-lib-deps --missing @all - Error: The following libraries are missing in the default context: - - a________ - - b________ - - c________ - - d________ - - e________ - - f________ - - h________ - - i________ - - j________ - - optional (optional) - Hint: try: - opam install a________ b________ c________ d________ e________ f________ h________ i________ j________ - [1] diff --git a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune b/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune deleted file mode 100644 index 2ed20024eab..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune +++ /dev/null @@ -1,18 +0,0 @@ -(library - (name foo) - (modules :standard \ prog) - (libraries a b c) - (preprocess (pps d e f))) - -(rule - (with-stdout-to file.ml - (echo %{lib-available:optional}))) - -(rule (with-stdout-to foo.ml (run prog))) - -(executable - (name prog) - (modules prog) - (libraries h i j)) - -(rule (with-stdout-to prog.ml (echo ""))) diff --git a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune-project b/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune-project deleted file mode 100644 index 4def4fa3e65..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/dune-project +++ /dev/null @@ -1,4 +0,0 @@ -(lang dune 1.9) -(name foo) - -(allow_approximate_merlin true) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t b/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t deleted file mode 100644 index 6b2e19f51e7..00000000000 --- a/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t +++ /dev/null @@ -1,14 +0,0 @@ -Expected: a, b, ..., j (required) and optional (optional) - - $ dune external-lib-deps @all - These are the external library dependencies in the default context: - - a - - b - - c - - d - - e - - f - - h - - i - - j - - optional (optional) diff --git a/test/blackbox-tests/test-cases/findlib.t/dune-project b/test/blackbox-tests/test-cases/findlib.t/dune-project deleted file mode 100644 index de4fc209200..00000000000 --- a/test/blackbox-tests/test-cases/findlib.t/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/findlib.t/foo.opam b/test/blackbox-tests/test-cases/findlib.t/foo.opam deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/test/blackbox-tests/test-cases/findlib.t/run.t b/test/blackbox-tests/test-cases/findlib.t/run.t deleted file mode 100644 index 0aa04387eb9..00000000000 --- a/test/blackbox-tests/test-cases/findlib.t/run.t +++ /dev/null @@ -1,31 +0,0 @@ - $ dune external-lib-deps @install - These are the external library dependencies in the default context: - - a - - b - - c - -Reproduction case for #484. The error should point to src/dune - - $ dune build @install - File "src/dune", line 4, characters 18-19: - 4 | (libraries a b c)) - ^ - Error: Library "c" not found. - Hint: try: - dune external-lib-deps --missing @install - [1] - -Note that the hint above is wrong. It doesn't matter too much as this -is for jbuilder which is deprecated and it doesn't seem worth making -the code of dune more complicated to fix the hint. - -With dune and an explicit profile, it is the same: - - $ dune build --profile dev @install - File "src/dune", line 4, characters 18-19: - 4 | (libraries a b c)) - ^ - Error: Library "c" not found. - Hint: try: - dune external-lib-deps --missing --profile dev @install - [1] diff --git a/test/blackbox-tests/test-cases/findlib.t/src/dune b/test/blackbox-tests/test-cases/findlib.t/src/dune deleted file mode 100644 index 6da78c65500..00000000000 --- a/test/blackbox-tests/test-cases/findlib.t/src/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name foo) - (public_name foo) - (libraries a b c)) diff --git a/test/blackbox-tests/test-cases/findlib.t/src/foo.ml b/test/blackbox-tests/test-cases/findlib.t/src/foo.ml deleted file mode 100644 index 2aee80ebb88..00000000000 --- a/test/blackbox-tests/test-cases/findlib.t/src/foo.ml +++ /dev/null @@ -1 +0,0 @@ -let x = A.x diff --git a/test/blackbox-tests/test-cases/findlib.t/test/dune b/test/blackbox-tests/test-cases/findlib.t/test/dune deleted file mode 100644 index 6d82b422751..00000000000 --- a/test/blackbox-tests/test-cases/findlib.t/test/dune +++ /dev/null @@ -1,3 +0,0 @@ -(library - (name test) - (libraries a b c)) diff --git a/test/blackbox-tests/test-cases/foreign-library.t/run.t b/test/blackbox-tests/test-cases/foreign-library.t/run.t index cb5df117fb8..8e76267ba48 100644 --- a/test/blackbox-tests/test-cases/foreign-library.t/run.t +++ b/test/blackbox-tests/test-cases/foreign-library.t/run.t @@ -768,8 +768,6 @@ Testsuite for the (foreign_library ...) stanza. 4 | (include_dirs (lib answer) (lib unknown_lib)) ^^^^^^^^^^^ Error: Library "unknown_lib" not found. - Hint: try: - dune external-lib-deps --missing some/dir/main.exe [1] ---------------------------------------------------------------------------------- diff --git a/test/blackbox-tests/test-cases/github1541.t/run.t b/test/blackbox-tests/test-cases/github1541.t/run.t index fecd2ceb0de..6d045bbb1b0 100644 --- a/test/blackbox-tests/test-cases/github1541.t/run.t +++ b/test/blackbox-tests/test-cases/github1541.t/run.t @@ -10,8 +10,6 @@ for libraries: 1 | (rule (with-stdout-to dummy (echo "%{lib:fakelib:bar.ml}"))) ^^^^^^^^^^^^^^^^^^^^^ Error: Library "fakelib" not found. - Hint: try: - dune external-lib-deps --missing ./dummy [1] for binaries: @@ -33,8 +31,6 @@ for libraries in the deps field: 1 | (rule (deps %{lib:fakelib:bar.ml}) (target dummy) (action (with-stdout-to %{target} (echo foo)))) ^^^^^^^^^^^^^^^^^^^^^ Error: Library "fakelib" not found. - Hint: try: - dune external-lib-deps --missing ./dummy [1] for binaries in the deps field: diff --git a/test/blackbox-tests/test-cases/github25.t/run.t b/test/blackbox-tests/test-cases/github25.t/run.t index 4a523fff63e..d481c0de392 100644 --- a/test/blackbox-tests/test-cases/github25.t/run.t +++ b/test/blackbox-tests/test-cases/github25.t/run.t @@ -15,5 +15,3 @@ We need ocamlfind to run this test Error: Library "une-lib-qui-nexiste-pas" not found. -> required by library "plop.ca-marche-pas" in .../plop - Hint: try: - dune external-lib-deps --missing --only pas-de-bol @install diff --git a/test/blackbox-tests/test-cases/github644.t/dune b/test/blackbox-tests/test-cases/github644.t/dune deleted file mode 100644 index 299bb8a0ff5..00000000000 --- a/test/blackbox-tests/test-cases/github644.t/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (name foo) - (inline_tests) - (preprocess - (pps ppx_that_doesn't_exist))) diff --git a/test/blackbox-tests/test-cases/github644.t/dune-project b/test/blackbox-tests/test-cases/github644.t/dune-project deleted file mode 100644 index 43a1282a9fa..00000000000 --- a/test/blackbox-tests/test-cases/github644.t/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.7) diff --git a/test/blackbox-tests/test-cases/github644.t/foo.ml b/test/blackbox-tests/test-cases/github644.t/foo.ml deleted file mode 100644 index 7fecab12d41..00000000000 --- a/test/blackbox-tests/test-cases/github644.t/foo.ml +++ /dev/null @@ -1 +0,0 @@ -let x = 42 diff --git a/test/blackbox-tests/test-cases/github644.t/run.t b/test/blackbox-tests/test-cases/github644.t/run.t deleted file mode 100644 index d3ae0288c67..00000000000 --- a/test/blackbox-tests/test-cases/github644.t/run.t +++ /dev/null @@ -1,21 +0,0 @@ - $ dune runtest - File "dune", line 5, characters 7-29: - 5 | (pps ppx_that_doesn't_exist))) - ^^^^^^^^^^^^^^^^^^^^^^ - Error: Library "ppx_that_doesn't_exist" not found. - Hint: try: - dune external-lib-deps --missing @runtest - [1] - -These should print something: - - $ dune external-lib-deps @runtest - These are the external library dependencies in the default context: - - ppx_that_doesn't_exist - - $ dune external-lib-deps --missing @runtest - Error: The following libraries are missing in the default context: - - ppx_that_doesn't_exist - Hint: try: - opam install ppx_that_doesn't_exist - [1] diff --git a/test/blackbox-tests/test-cases/lib.t/run.t b/test/blackbox-tests/test-cases/lib.t/run.t index 15e82fc74e1..cfea52628e6 100644 --- a/test/blackbox-tests/test-cases/lib.t/run.t +++ b/test/blackbox-tests/test-cases/lib.t/run.t @@ -251,6 +251,4 @@ But will fail when we release it, as it will need to run with -p: 5 | (with-stdout-to lib2.ml (echo "let _ = {|%{lib-private:lib1:lib1.ml}|}"))) ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Library "lib1" not found. - Hint: try: - dune external-lib-deps --missing --only-packages public_lib2 @install [1] diff --git a/test/blackbox-tests/test-cases/libexec.t/run.t b/test/blackbox-tests/test-cases/libexec.t/run.t index 909b1fa891e..31f8f5b181a 100644 --- a/test/blackbox-tests/test-cases/libexec.t/run.t +++ b/test/blackbox-tests/test-cases/libexec.t/run.t @@ -313,6 +313,4 @@ But will fail when we release it, as it will need to run with -p: 5 | (with-stdout-to lib2.ml (echo "let _ = {|%{libexec-private:lib1:lib1.ml}|}"))) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Library "lib1" not found. - Hint: try: - dune external-lib-deps --missing --only-packages public_lib2 --workspace ../dune-workspace @target [1] diff --git a/test/blackbox-tests/test-cases/optional-executable.t/run.t b/test/blackbox-tests/test-cases/optional-executable.t/run.t index d786f6d1890..15dacb084ba 100644 --- a/test/blackbox-tests/test-cases/optional-executable.t/run.t +++ b/test/blackbox-tests/test-cases/optional-executable.t/run.t @@ -26,8 +26,6 @@ Test optional executable 3 | (libraries does-not-exist) ^^^^^^^^^^^^^^ Error: Library "does-not-exist" not found. - Hint: try: - dune external-lib-deps --missing @all [1] $ dune build @run-x @@ -35,8 +33,6 @@ Test optional executable 3 | (libraries does-not-exist) ^^^^^^^^^^^^^^ Error: Library "does-not-exist" not found. - Hint: try: - dune external-lib-deps --missing @run-x [1] Reproduction case for a bug in dune < 2.4 where all executables where @@ -55,6 +51,4 @@ The following command should fail because the executable is not optional: 3 | (libraries does-not-exist)) ^^^^^^^^^^^^^^ Error: Library "does-not-exist" not found. - Hint: try: - dune external-lib-deps --missing @install [1] diff --git a/test/blackbox-tests/test-cases/optional.t/run.t b/test/blackbox-tests/test-cases/optional.t/run.t index de45a0e29a1..49e176a4f37 100644 --- a/test/blackbox-tests/test-cases/optional.t/run.t +++ b/test/blackbox-tests/test-cases/optional.t/run.t @@ -46,6 +46,4 @@ The following command should fail because the executable is not optional: 4 | (libraries lib_that_doesn't_exist)) ^^^^^^^^^^^^^^^^^^^^^^ Error: Library "lib_that_doesn't_exist" not found. - Hint: try: - dune external-lib-deps --missing @install [1] diff --git a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t index 1f3a2e6f956..7d69e51848d 100644 --- a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t +++ b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t @@ -9,6 +9,4 @@ -> required by lib/lib.pp.ml (context cross-environment) -> required by alias lib/all (context cross-environment) -> required by alias default (context cross-environment) - Hint: try: - dune external-lib-deps --missing --debug-dependency-path @@default [1] diff --git a/test/blackbox-tests/test-cases/virtual-libraries/no-vlib-present.t/run.t b/test/blackbox-tests/test-cases/virtual-libraries/no-vlib-present.t/run.t index 72222f36378..51fed9baecb 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/no-vlib-present.t/run.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/no-vlib-present.t/run.t @@ -4,6 +4,4 @@ Test that implementing vlibs that aren't present is impossible 3 | (implements foobar12312414)) ^^^^^^^^^^^^^^ Error: Library "foobar12312414" not found. - Hint: try: - dune external-lib-deps --missing @@default [1]