Merge branch 'main' into ps/branch/fix_stdune___make_sure_path_drop_p…

…refix_drops_path_prefixes_only

Signed-off-by: Ali Caglayan <[email protected]>

Makefile

@@ -20,7 +20,7 @@ menhir \
 ocamlfind \
 ocamlformat.$$(awk -F = '$$1 == "version" {print $$2}' .ocamlformat) \
 "odoc>=2.0.1" \
-"ppx_expect.v0.15.0" \
+"ppx_expect>=v0.16.0" \
 ppx_inline_test \
 ppxlib \
 ctypes \

bin/alias.ml

@@ -84,7 +84,7 @@ let dep_on_alias_multi_contexts ~dir ~name ~contexts =
 let dep_on_alias_rec_multi_contexts ~dir:src_dir ~name ~contexts =
   let open Action_builder.O in
   let* dir = Action_builder.of_memo (find_dir_specified_on_command_line ~dir:src_dir) in
-  let+ alias_statuses =
+  let* alias_statuses =
     Action_builder.all
       (List.map contexts ~f:(fun ctx ->
          let dir =
@@ -94,15 +94,37 @@ let dep_on_alias_rec_multi_contexts ~dir:src_dir ~name ~contexts =
          in
          Dune_rules.Alias_rec.dep_on_alias_rec name dir))
   in
-  let is_nonempty =
-    List.exists alias_statuses ~f:(fun (x : Action_builder.Alias_status.t) ->
+  match
+    Alias.is_standard name
+    || List.exists alias_statuses ~f:(fun (x : Action_builder.Alias_status.t) ->
       match x with
       | Defined -> true
       | Not_defined -> false)
-  in
-  if (not is_nonempty) && not (Alias.is_standard name)
-  then
+  with
+  | true -> Action_builder.return ()
+  | false ->
+    let* load_dir =
+      Action_builder.all
+      @@ List.map contexts ~f:(fun ctx ->
+        let dir =
+          Source_tree.Dir.path dir
+          |> Path.Build.append_source (Context_name.build_dir ctx)
+          |> Path.build
+        in
+        Action_builder.of_memo @@ Load_rules.load_dir ~dir)
+    in
+    let hints =
+      let candidates =
+        Alias.Name.Set.union_map load_dir ~f:(function
+          | Load_rules.Loaded.Build build -> Alias.Name.Set.of_keys build.aliases
+          | _ -> Alias.Name.Set.empty)
+      in
+      User_message.did_you_mean
+        (Alias.Name.to_string name)
+        ~candidates:(Alias.Name.Set.to_list_map ~f:Alias.Name.to_string candidates)
+    in
     User_error.raise
+      ~hints
       [ Pp.textf
           "Alias %S specified on the command line is empty."
           (Alias.Name.to_string name)

bin/common.ml

@@ -1249,6 +1249,11 @@ let init (builder : Builder.t) =
         }
   in
   Log.info [ Pp.textf "Shared cache: %s" (Config.Toggle.to_string config.cache_enabled) ];
+  Log.info
+    [ Pp.textf
+        "Shared cache location: %s"
+        (Path.to_string Dune_cache_storage.Layout.root_dir)
+    ];
   let action_runner =
     match builder.action_runner with
     | No -> None

bin/pkg.ml

@@ -39,7 +39,8 @@ module Per_context = struct
   type t =
     { lock_dir_path : Path.Source.t
     ; version_preference : Version_preference.t
-    ; solver_env : Dune_pkg.Solver_env.t
+    ; solver_sys_vars : Dune_pkg.Solver_env.Variable.Sys.Bindings.t option
+    ; repositories : Dune_pkg.Pkg_workspace.Repository.Name.t list
     ; context_common : Dune_rules.Workspace.Context.Common.t
     ; repos :
         Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t
@@ -77,7 +78,8 @@ module Per_context = struct
            (Default
              { lock
              ; version_preference = version_preference_context
-             ; solver_env
+             ; solver_sys_vars
+             ; repositories
              ; base = context_common
              ; _
              }) ->
@@ -86,7 +88,8 @@ module Per_context = struct
                Version_preference.choose
                  ~from_arg:version_preference_arg
                  ~from_context:version_preference_context
-           ; solver_env = Option.value solver_env ~default:Dune_pkg.Solver_env.default
+           ; solver_sys_vars
+           ; repositories
            ; context_common
            ; repos = repositories_of_workspace workspace
            }
@@ -104,7 +107,8 @@ module Per_context = struct
             { lock
             ; version_preference = version_preference_context
             ; base = context_common
-            ; solver_env
+            ; solver_sys_vars
+            ; repositories
             } ->
           let lock_dir_path = Option.value lock ~default:Dune_pkg.Lock_dir.default_path in
           Some
@@ -114,7 +118,8 @@ module Per_context = struct
                   ~from_arg:version_preference_arg
                   ~from_context:version_preference_context
             ; context_common
-            ; solver_env = Option.value solver_env ~default:Dune_pkg.Solver_env.default
+            ; solver_sys_vars
+            ; repositories
             ; repos = repositories_of_workspace workspace
             }
         | Opam _ -> None)
@@ -149,31 +154,31 @@ module Per_context = struct
   ;;
 end
 
-module Print_solver_env = struct
-  (* The system environment variables used by the solver are taken from the
-     current system by default but can be overridden by the build context. *)
-  let override_solver_env_variables
-    ~solver_env_from_context
-    ~sys_bindings_from_current_system
-    =
-    Dune_pkg.Solver_env.(
-      Variable.Sys.Bindings.extend
-        sys_bindings_from_current_system
-        (sys solver_env_from_context)
-      |> set_sys solver_env_from_context)
-  ;;
+(* The system environment variables used by the solver are taken from the
+   current system by default but can be overridden by the build context. *)
+let solver_env_variables ~solver_sys_vars_from_context ~sys_bindings_from_current_system =
+  match solver_sys_vars_from_context with
+  | None -> sys_bindings_from_current_system
+  | Some solver_env_variables ->
+    Dune_pkg.Solver_env.Variable.Sys.Bindings.extend
+      sys_bindings_from_current_system
+      solver_env_variables
+;;
 
+module Print_solver_env = struct
   let print_solver_env_for_one_context
     ~sys_bindings_from_current_system
-    { Per_context.solver_env = solver_env_from_context
+    { Per_context.solver_sys_vars = solver_sys_vars_from_context
     ; context_common = { name = context_name; _ }
     ; _
     }
     =
     let solver_env =
-      override_solver_env_variables
-        ~solver_env_from_context
-        ~sys_bindings_from_current_system
+      Dune_pkg.Solver_env.create
+        ~sys:
+          (solver_env_variables
+             ~solver_sys_vars_from_context
+             ~sys_bindings_from_current_system)
     in
     Console.print
       [ Pp.textf
@@ -302,7 +307,7 @@ module Lock = struct
     ;;
   end
 
-  let get_repos repos solver_env ~opam_repository_path ~opam_repository_url =
+  let get_repos repos ~opam_repository_path ~opam_repository_url ~repositories =
     let open Fiber.O in
     match opam_repository_path, opam_repository_url with
     | Some _, Some _ ->
@@ -325,8 +330,7 @@ module Lock = struct
          User_error.raise
            [ Pp.text "Can't determine the location of the opam-repository" ])
     | None, None ->
-      (* read from workspace *)
-      Dune_pkg.Solver_env.repos solver_env
+      repositories
       |> Fiber.parallel_map ~f:(fun name ->
         match Dune_pkg.Pkg_workspace.Repository.Name.Map.find repos name with
         | None ->
@@ -399,29 +403,36 @@ module Lock = struct
              { Per_context.lock_dir_path
              ; version_preference
              ; repos
-             ; solver_env = solver_env_from_context
+             ; solver_sys_vars = solver_sys_vars_from_context
              ; context_common = { name = context_name; _ }
+             ; repositories
              }
            ->
            let solver_env =
-             Print_solver_env.override_solver_env_variables
-               ~solver_env_from_context
-               ~sys_bindings_from_current_system
+             Dune_pkg.Solver_env.create
+               ~sys:
+                 (solver_env_variables
+                    ~solver_sys_vars_from_context
+                    ~sys_bindings_from_current_system)
            in
-           let+ repos =
-             get_repos repos solver_env ~opam_repository_path ~opam_repository_url
+           let* repos =
+             get_repos repos ~opam_repository_path ~opam_repository_url ~repositories
            in
-           match
-             Console.Status_line.with_overlay
-               (Constant (Pp.text "Solving for Build Plan"))
-               ~f:(fun () ->
-                 Dune_pkg.Opam_solver.solve_lock_dir
-                   solver_env
-                   version_preference
-                   repos
-                   ~local_packages
-                   ~experimental_translate_opam_filters)
-           with
+           let overlay =
+             Console.Status_line.add_overlay (Constant (Pp.text "Solving for Build Plan"))
+           in
+           Fiber.finalize
+             ~finally:(fun () ->
+               Console.Status_line.remove_overlay overlay;
+               Fiber.return ())
+             (fun () ->
+               Dune_pkg.Opam_solver.solve_lock_dir
+                 solver_env
+                 version_preference
+                 repos
+                 ~local_packages
+                 ~experimental_translate_opam_filters)
+           >>| function
            | Error (`Diagnostic_message message) -> Error (context_name, message)
            | Ok { lock_dir; files; _ } ->
              let summary_message =
@@ -565,18 +576,17 @@ module Outdated = struct
                 { Per_context.lock_dir_path
                 ; version_preference = _
                 ; repos
-                ; solver_env = solver_env_from_context
+                ; solver_sys_vars = _
                 ; context_common = _
+                ; repositories
                 }
               ->
-              let solver_env =
-                Print_solver_env.override_solver_env_variables
-                  ~solver_env_from_context
-                  ~sys_bindings_from_current_system:
-                    Dune_pkg.Solver_env.Variable.Sys.Bindings.empty
-              in
               let+ repos =
-                Lock.get_repos repos solver_env ~opam_repository_path ~opam_repository_url
+                Lock.get_repos
+                  repos
+                  ~opam_repository_path
+                  ~opam_repository_url
+                  ~repositories
               and+ local_packages = Lock.find_local_packages in
               let lock_dir = Lock_dir.read_disk lock_dir_path in
               let results =

bin/print_rules.ml

@@ -128,9 +128,9 @@ let print_rule_sexp ppf (rule : Dune_engine.Reflection.Rule.t) =
                  ; "directories", paths rule.targets.dirs
                  ] )
            ]
-         ; (match rule.context with
+         ; (match Path.Build.extract_build_context rule.dir with
             | None -> []
-            | Some c -> [ "context", Dune_engine.Context_name.encode c.name ])
+            | Some (c, _) -> [ "context", Dune_sexp.atom_or_quoted_string c ])
          ; [ "action", sexp_of_action rule.action ]
          ])
   in

doc/changes/8949.md

@@ -0,0 +1,2 @@
+- Correctly determine the stanza of menhir modules when `(include_subdirs
+  qualified)` is enabled (@rgrinberg, #8949, fixes #7610)

doc/changes/8974.md

@@ -0,0 +1 @@
+- Display cache location in Dune log (#8974, @nojb)

doc/changes/package-dirs.md

@@ -0,0 +1,3 @@
+- Mark installed directories in `dune-package` files. This fixes `(package)`
+  dependencies against packages that contain such directories. (#8953, fixes
+  #8915, @emillon)

otherlibs/dyn/dyn.ml

@@ -112,7 +112,11 @@ let rec pp =
   | Variant (v, xs) ->
     Pp.hvbox
       ~indent:2
-      (Pp.concat [ Pp.verbatim v; Pp.space; Pp.concat_map ~sep:(Pp.char ',') xs ~f:pp ])
+      (Pp.concat
+         [ Pp.verbatim v
+         ; Pp.space
+         ; Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp
+         ])
 ;;
 
 let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)

otherlibs/ocamlc-loc/test/ocamlc_loc_tests.ml

@@ -169,7 +169,7 @@ Error: Signature mismatch:
   [%expect
     {|
     >> error 0
-    { loc = { path = "test.ml"; line = Range 3,5; chars = Some (6, 3) }
+    { loc = { path = "test.ml"; line = Range 3, 5; chars = Some (6, 3) }
     ; message =
         "Signature mismatch:\n\
          Modules do not match:\n\
@@ -316,7 +316,7 @@ Error: Some record fields are undefined: signal_watcher
     >> error 0
     { loc =
         { path = "test/expect-tests/timer_tests.ml"
-        ; line = Range 6,10
+        ; line = Range 6, 10
         ; chars = Some (2, 3)
         }
     ; message = "Some record fields are undefined: signal_watcher"
@@ -573,7 +573,7 @@ Case
     >> error 0
     { loc =
         { path = "src/dune_engine/action.ml"
-        ; line = Range 34,96
+        ; line = Range 34, 96
         ; chars = Some (4, 64)
         }
     ; message =
@@ -586,7 +586,7 @@ Case
     >> error 1
     { loc =
         { path = "src/dune_engine/action.ml"
-        ; line = Range 291,315
+        ; line = Range 291, 315
         ; chars = Some (2, 22)
         }
     ; message =
@@ -599,7 +599,7 @@ Case
     >> error 2
     { loc =
         { path = "src/dune_engine/action.ml"
-        ; line = Range 339,363
+        ; line = Range 339, 363
         ; chars = Some (21, 24)
         }
     ; message =
@@ -612,7 +612,7 @@ Case
     >> error 3
     { loc =
         { path = "src/dune_engine/action.ml"
-        ; line = Range 391,414
+        ; line = Range 391, 414
         ; chars = Some (4, 70)
         }
     ; message =

otherlibs/stdune/src/list.mli

@@ -60,3 +60,5 @@ val max : 'a list -> f:('a -> 'a -> Ordering.t) -> 'a option
 val mem : 'a list -> 'a -> equal:('a -> 'a -> bool) -> bool
 val split_while : 'a t -> f:('a -> bool) -> 'a t * 'a t
 val truncate : max_length:int -> 'a t -> [> `Not_truncated of 'a t | `Truncated of 'a t ]
+val of_seq : 'a Seq.t -> 'a t
+val to_seq : 'a t -> 'a Seq.t

otherlibs/stdune/src/set.ml

@@ -21,6 +21,7 @@ module Make (Key : Map_intf.Key) (M : Map_intf.S with type key = Key.t) = struct
   let remove t x = remove x t
   let compare a b = Ordering.of_int (compare a b)
   let is_subset t ~of_ = subset t of_
+  let are_disjoint a b = not (exists a ~f:(mem b))
   let iter t ~f = iter t ~f
   let map t ~f = map t ~f
   let fold t ~init ~f = fold t ~init ~f
@@ -102,6 +103,7 @@ module Of_map (Key : Map_intf.Key) (Map : Map_intf.S with type key = Key.t) = st
     | exception Not_a_subset -> false
   ;;
 
+  let are_disjoint a b = not (Map.existsi a ~f:(fun k () -> mem b k))
   let iter t ~f = Map.iteri t ~f:(fun k () -> f k)
   let fold t ~init ~f = Map.foldi t ~init ~f:(fun k () acc -> f k acc)
   let map t ~f = fold t ~init:empty ~f:(fun x acc -> add acc (f x))

otherlibs/stdune/src/set_intf.ml

@@ -15,6 +15,7 @@ module type S = sig
   val compare : t -> t -> Ordering.t
   val equal : t -> t -> bool
   val is_subset : t -> of_:t -> bool
+  val are_disjoint : t -> t -> bool
   val iter : t -> f:(elt -> unit) -> unit
   val map : t -> f:(elt -> elt) -> t
   val fold : t -> init:'a -> f:(elt -> 'a -> 'a) -> 'a