Dune Pins itself (#12583)

* Reproduce issue in #12381

The version of dune inside the opam repo is overriding the version of
dune that is being used. That seems wrong. At least most of the time.

Signed-off-by: Rudi Grinberg <[email protected]>

* Remove [Resolved_package.set_url]

Fuse it with [git_repo] since that is the only place where it's needed

Signed-off-by: Rudi Grinberg <[email protected]>

* fix(pkg): make dune pin itelf

Automatically make dune pin itself. We're going to assume that the dune
we're using right now is the one that will be used to run the build
plan.

Perhaps this behavior isn't always deired. We could imagine wanting to
produce build plans for older or newer dunes. For now, this is a good
default though.

Addresses #12381

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

src/dune_pkg/dune_dep.ml

@@ -6,3 +6,6 @@ let version =
   let major, minor = Dune_lang.Stanza.latest_version in
   OpamPackage.Version.of_string @@ sprintf "%d.%d" major minor
 ;;
+
+let package = OpamPackage.create (Package_name.to_opam_package_name name) version
+let opam_file = OpamFile.OPAM.create package

src/dune_pkg/dune_dep.mli

@@ -1,2 +1,4 @@
 val name : Package_name.t
 val version : OpamPackage.Version.t
+val package : OpamPackage.t
+val opam_file : OpamFile.OPAM.t

src/dune_pkg/opam_repo.ml

@@ -134,7 +134,7 @@ let load_opam_package_from_dir ~(dir : Path.t) package =
   | false -> None
   | true ->
     let files_dir = Some (Paths.files_dir package) in
-    Some (Resolved_package.local_fs package ~dir ~opam_file_path ~files_dir)
+    Some (Resolved_package.local_fs package ~dir ~opam_file_path ~files_dir ~url:None)
 ;;
 
 let load_packages_from_git rev_store opam_packages =
@@ -151,7 +151,8 @@ let load_packages_from_git rev_store opam_packages =
         ~opam_file:(Rev_store.File.path opam_file)
         ~opam_file_contents
         rev
-        ~files_dir:(Some files_dir))
+        ~files_dir:(Some files_dir)
+        ~url:None)
 ;;
 
 let all_packages_in_dir_at_path ~dir ~path loc =

src/dune_pkg/opam_solver.ml

@@ -348,6 +348,8 @@ module Context = struct
   let user_restrictions : t -> OpamPackage.Name.t -> OpamFormula.version_constraint option
     =
     fun t pkg ->
+    (* This isn't really needed because we already pin dune, but it seems to
+       help the error messages *)
     if Package_name.equal Dune_dep.name (Package_name.of_opam_package_name pkg)
     then Some (`Eq, t.dune_version)
     else None
@@ -1658,6 +1660,18 @@ let solve_lock_dir
       ~selected_depopts
       ~portable_lock_dir
   =
+  let pinned_packages =
+    Package_name.Map.update pinned_packages Dune_dep.name ~f:(function
+      | None -> Some Resolved_package.dune
+      | Some p ->
+        let loc = Resolved_package.loc p in
+        User_error.raise
+          ~loc
+          [ Pp.text
+              "Dune cannot be pinned. The currently running version is the only one that \
+               may be used"
+          ])
+  in
   let pinned_package_names = Package_name.Set.of_keys pinned_packages in
   let stats_updater = Solver_stats.Updater.init () in
   let context =

src/dune_pkg/pinned_package.ml

@@ -66,39 +66,38 @@ let resolve_package { Local_package.loc; url = loc_url, url; name; version; orig
       (Package_name.to_opam_package_name name)
       (Package_version.to_opam_package_version version)
   in
-  let+ resolved_package =
-    let* mount = Mount.of_opam_url loc_url url in
-    let* opam_file_path, files_dir = discover_layout loc name mount in
-    match Mount.backend mount with
-    | Path dir ->
-      Resolved_package.local_fs package ~dir ~opam_file_path ~files_dir |> Fiber.return
-    | Git rev ->
-      let+ opam_file_contents =
-        (* CR-rgrinberg: not efficient to make such individual calls *)
-        Mount.read mount opam_file_path
-        >>| function
-        | Some p -> p
-        | None ->
-          let files =
-            match Path.Local.parent opam_file_path with
-            | None -> []
-            | Some parent ->
-              Rev_store.At_rev.directory_entries rev parent ~recursive:false
-              |> Rev_store.File.Set.to_list_map ~f:Rev_store.File.path
-          in
-          Code_error.raise
-            ~loc
-            "unable to find file"
-            [ "opam_file_path", Path.Local.to_dyn opam_file_path
-            ; "files", Dyn.list Path.Local.to_dyn files
-            ]
-      in
-      Resolved_package.git_repo
-        package
-        ~opam_file:opam_file_path
-        ~opam_file_contents
-        rev
-        ~files_dir
-  in
-  Resolved_package.set_url resolved_package url
+  let* mount = Mount.of_opam_url loc_url url in
+  let* opam_file_path, files_dir = discover_layout loc name mount in
+  match Mount.backend mount with
+  | Path dir ->
+    Resolved_package.local_fs package ~dir ~opam_file_path ~files_dir ~url:(Some url)
+    |> Fiber.return
+  | Git rev ->
+    let+ opam_file_contents =
+      (* CR-rgrinberg: not efficient to make such individual calls *)
+      Mount.read mount opam_file_path
+      >>| function
+      | Some p -> p
+      | None ->
+        let files =
+          match Path.Local.parent opam_file_path with
+          | None -> []
+          | Some parent ->
+            Rev_store.At_rev.directory_entries rev parent ~recursive:false
+            |> Rev_store.File.Set.to_list_map ~f:Rev_store.File.path
+        in
+        Code_error.raise
+          ~loc
+          "unable to find file"
+          [ "opam_file_path", Path.Local.to_dyn opam_file_path
+          ; "files", Dyn.list Path.Local.to_dyn files
+          ]
+    in
+    Resolved_package.git_repo
+      package
+      ~opam_file:opam_file_path
+      ~opam_file_contents
+      rev
+      ~files_dir
+      ~url:(Some url)
 ;;

src/dune_pkg/resolved_package.ml

@@ -4,22 +4,38 @@ type extra_files =
   | Inside_files_dir of Path.t option
   | Git_files of Path.Local.t option * Rev_store.At_rev.t
 
-type nonrec t =
+type rest =
   { opam_file : OpamFile.OPAM.t
   ; package : OpamPackage.t
   ; extra_files : extra_files
   ; loc : Loc.t
   ; dune_build : bool
   }
 
-let dune_build t = t.dune_build
-let loc t = t.loc
-let package t = t.package
-let opam_file t = t.opam_file
+type nonrec t =
+  | Dune
+  | Rest of rest
+
+let dune = Dune
+
+let dune_build = function
+  | Dune -> false
+  | Rest t -> t.dune_build
+;;
+
+let loc = function
+  | Dune -> Loc.none
+  | Rest t -> t.loc
+;;
 
-let set_url t url =
-  let opam_file = OpamFile.OPAM.with_url (OpamFile.URL.create url) t.opam_file in
-  { t with opam_file }
+let package = function
+  | Dune -> Dune_dep.package
+  | Rest t -> t.package
+;;
+
+let opam_file = function
+  | Dune -> Dune_dep.opam_file
+  | Rest t -> t.opam_file
 ;;
 
 let add_opam_package_to_opam_file package opam_file =
@@ -28,37 +44,44 @@ let add_opam_package_to_opam_file package opam_file =
   |> OpamFile.OPAM.with_name (OpamPackage.name package)
 ;;
 
-let read_opam_file package ~opam_file_path ~opam_file_contents =
-  Opam_file.read_from_string_exn ~contents:opam_file_contents opam_file_path
-  |> add_opam_package_to_opam_file package
+let read_opam_file package ~opam_file_path ~opam_file_contents ~url =
+  let opam_file =
+    Opam_file.read_from_string_exn ~contents:opam_file_contents opam_file_path
+    |> add_opam_package_to_opam_file package
+  in
+  match url with
+  | None -> opam_file
+  | Some url -> OpamFile.OPAM.with_url (OpamFile.URL.create url) opam_file
 ;;
 
-let git_repo package ~opam_file ~opam_file_contents rev ~files_dir =
+let git_repo package ~opam_file ~opam_file_contents rev ~files_dir ~url =
   let opam_file_path = Path.of_local opam_file in
-  let opam_file = read_opam_file package ~opam_file_path ~opam_file_contents in
+  let opam_file = read_opam_file package ~opam_file_path ~opam_file_contents ~url in
   let loc = Loc.in_file opam_file_path in
-  { dune_build = false
-  ; loc
-  ; package
-  ; opam_file
-  ; extra_files = Git_files (files_dir, rev)
-  }
+  Rest
+    { dune_build = false
+    ; loc
+    ; package
+    ; opam_file
+    ; extra_files = Git_files (files_dir, rev)
+    }
 ;;
 
-let local_fs package ~dir ~opam_file_path ~files_dir =
+let local_fs package ~dir ~opam_file_path ~files_dir ~url =
   let opam_file_path = Path.append_local dir opam_file_path in
   let files_dir = Option.map files_dir ~f:(Path.append_local dir) in
   let opam_file =
     let opam_file_contents = Io.read_file ~binary:true opam_file_path in
-    read_opam_file package ~opam_file_path ~opam_file_contents
+    read_opam_file package ~opam_file_path ~opam_file_contents ~url
   in
   let loc = Loc.in_file opam_file_path in
-  { dune_build = false
-  ; loc
-  ; package
-  ; extra_files = Inside_files_dir files_dir
-  ; opam_file
-  }
+  Rest
+    { dune_build = false
+    ; loc
+    ; package
+    ; extra_files = Inside_files_dir files_dir
+    ; opam_file
+    }
 ;;
 
 (* Scan a path recursively down retrieving a list of all files together with their
@@ -92,18 +115,26 @@ let local_package ~command_source loc opam_file opam_package =
   in
   let opam_file = add_opam_package_to_opam_file opam_package opam_file in
   let package = OpamFile.OPAM.package opam_file in
-  { dune_build; opam_file; package; loc; extra_files = Inside_files_dir None }
+  Rest { dune_build; opam_file; package; loc; extra_files = Inside_files_dir None }
 ;;
 
 open Fiber.O
 
 let get_opam_package_files resolved_packages =
   let indexed = List.mapi resolved_packages ~f:(fun i w -> i, w) |> Int.Map.of_list_exn in
   let from_dirs, from_git =
-    Int.Map.partition_map indexed ~f:(fun (resolved_package : t) ->
-      match resolved_package.extra_files with
-      | Git_files (files_dir, rev) -> Right (files_dir, rev)
-      | Inside_files_dir dir -> Left dir)
+    let _dune, without_dune =
+      Int.Map.partition_map indexed ~f:(function
+        | Dune -> Left ()
+        | Rest t -> Right t)
+    in
+    let dirs, git =
+      Int.Map.partition_map without_dune ~f:(fun (resolved_package : rest) ->
+        match resolved_package.extra_files with
+        | Git_files (files_dir, rev) -> Right (files_dir, rev)
+        | Inside_files_dir dir -> Left dir)
+    in
+    dirs, git
   in
   let+ from_git =
     if Int.Map.is_empty from_git

src/dune_pkg/resolved_package.mli

@@ -5,22 +5,24 @@ type t
 val package : t -> OpamPackage.t
 val opam_file : t -> OpamFile.OPAM.t
 val loc : t -> Loc.t
-val set_url : t -> OpamUrl.t -> t
 val dune_build : t -> bool
+val dune : t
 
 val git_repo
   :  OpamPackage.t
   -> opam_file:Path.Local.t
   -> opam_file_contents:string
   -> Rev_store.At_rev.t
   -> files_dir:Path.Local.t option
+  -> url:OpamUrl.t option
   -> t
 
 val local_fs
   :  OpamPackage.t
   -> dir:Path.t
   -> opam_file_path:Path.Local.t
   -> files_dir:Path.Local.t option
+  -> url:OpamUrl.t option
   -> t
 
 val local_package

test/blackbox-tests/test-cases/pkg/implicit-dune-constraint.t

@@ -6,9 +6,6 @@ dependency.
   $ . ./helpers.sh
   $ mkrepo
 
-  $ mkpkg dune 3.11.0 <<EOF
-  > EOF
-
   $ test() {
   > mkpkg foo <<EOF
   > depends: [ "dune" {<= "$1"} ]
@@ -23,12 +20,17 @@ dependency.
   Selected candidates: foo.0.0.1 x.dev
   - dune -> (problem)
       User requested = 3.XX
+      foo 0.0.1 requires <= 2.0.0
       Rejected candidates:
-        dune.3.XX.0: Incompatible with restriction: = 3.XX
+        dune.3.XX: Incompatible with restriction: <= 2.0.0
   $ test "4.0.0"
   Solution for dune.lock:
   - foo.0.0.1
 
+  $ test "4.0.0" 2>&1 | sed -E 's/3.[0-9]+/3.XX/g'
+  Solution for dune.lock:
+  - foo.0.0.1
+
 Create a fake project and ensure `dune` can be used as a dependency:
   $ cat > dune-project <<EOF
   > (lang dune 3.13)

test/blackbox-tests/test-cases/pkg/pin-stanza/pin-dune.t

@@ -0,0 +1,34 @@
+Pinning dune itself
+
+  $ . ../helpers.sh
+
+  $ mkrepo
+  $ add_mock_repo_if_needed
+
+# CR-someday rgrinberg: ideally, this source shouldn't be necessary and we
+# should disqualify this pin without resolving any sources
+
+  $ mkdir _extra_source
+  $ cat >_extra_source/dune-project <<EOF
+  > (lang dune 3.12)
+  > (package (name dune))
+  > EOF
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.13)
+  > (pin
+  >  (url "file://$PWD/_extra_source")
+  >  (package (name dune)))
+  > (package
+  >   (name main))
+  > EOF
+
+For now, pinning dune is not allowed:
+
+  $ dune pkg lock
+  File "dune-project", line 4, characters 1-22:
+  4 |  (package (name dune)))
+       ^^^^^^^^^^^^^^^^^^^^^
+  Error: Dune cannot be pinned. The currently running version is the only one
+  that may be used
+  [1]

test/blackbox-tests/test-cases/pkg/unsatisfied-version-constraint-on-dune.t

@@ -22,8 +22,12 @@ project:
 
 Solve the dependencies:
   $ dune pkg lock 2>&1 | sed -E 's/"3.[0-9]+"/"3.XX"/'
-  Error: The current version of Dune does not satisfy the version constraints
-  for Dune in this project's dependencies.
-  Details:
-  Found version "3.XX" of package "dune" which doesn't satisfy the required
-  version constraint "< 3.0"
+  Error: Unable to solve dependencies for the following lock directories:
+  Lock directory dune.lock:
+  Couldn't solve the package dependency formula.
+  Selected candidates: foo.dev
+  - dune -> (problem)
+      User requested = 3.21
+      foo dev requires < 3.0
+      Rejected candidates:
+        dune.3.21: Incompatible with restriction: < 3.0