fix(ctypes): add proper user message for missing modules

Signed-off-by: Ali Caglayan <alizter@gmail.com>

Author: Alizter

src/dune_rules/buildable_rules.ml

@@ -94,6 +94,9 @@ let modules_rules
       ~preprocessor_deps
       ~lint
       ~empty_module_interface_if_absent
+      ~ctypes
+      ~modules_loc
+      ~buildable_loc
       sctx
       expander
       ~dir
@@ -135,6 +138,39 @@ let modules_rules
         fun name -> default || List.mem executable_names name ~equal:Module_name.equal)
       else fun _ -> default
   in
+  let* () =
+    match ctypes with
+    | Some ctypes ->
+      let (ctypes : Ctypes_field.t) = ctypes in
+      let modules = Modules.With_vlib.modules modules in
+      (* Here we collect all the modules that ctypes expects to be present in
+         that stanza in order to validate their existence. We do this using
+         [Memo.parallel_iter] in order to collect all the errors rather than
+         just the first occurances. *)
+      (ctypes.type_description.functor_loc, ctypes.type_description.functor_)
+      :: List.map
+           ~f:(fun (x : Ctypes_field.Function_description.t) -> x.functor_loc, x.functor_)
+           ctypes.function_description
+      |> Memo.parallel_iter ~f:(fun ((functor_loc, m) : Loc.t * Module_name.t) ->
+        match Modules.With_vlib.find modules m with
+        | Some _ -> Memo.return ()
+        | None ->
+          let loc =
+            Option.first_some modules_loc buildable_loc
+            |> Option.value
+                 ~default:
+                   (Path.build dir |> Path.drop_optional_build_context |> Loc.in_dir)
+          in
+          User_error.raise
+            ~loc
+            [ Pp.textf
+                "Module %s is required by ctypes at %s but is missing in the modules \
+                 field of the stanza."
+                (Module_name.to_string m)
+                (Loc.to_file_colon_line functor_loc)
+            ])
+    | None -> Memo.return ()
+  in
   let+ modules =
     Modules.map_user_written modules ~f:(fun m ->
       let* m = Pp_spec.pp_module pp m in
@@ -159,15 +195,31 @@ let modules_rules sctx kind expander ~dir scope modules =
           [ Pp.text "The compiler you are using is not compatible with library parameter"
           ]
   in
-  let preprocess, preprocessor_deps, lint, empty_module_interface_if_absent =
+  let ( preprocess
+      , preprocessor_deps
+      , lint
+      , empty_module_interface_if_absent
+      , ctypes
+      , modules_loc
+      , buildable_loc )
+    =
     match kind with
     | Executables (buildable, _) | Library (buildable, _) | Parameter (buildable, _) ->
       ( buildable.preprocess
       , buildable.preprocessor_deps
       , buildable.lint
-      , buildable.empty_module_interface_if_absent )
+      , buildable.empty_module_interface_if_absent
+      , buildable.ctypes
+      , Ordered_set_lang.Unexpanded.loc buildable.modules.modules
+      , Some buildable.loc )
     | Melange { preprocess; preprocessor_deps; lint; empty_module_interface_if_absent } ->
-      preprocess, preprocessor_deps, lint, empty_module_interface_if_absent
+      ( preprocess
+      , preprocessor_deps
+      , lint
+      , empty_module_interface_if_absent
+      , None
+      , None
+      , None )
   in
   let lib_name =
     match kind with
@@ -184,6 +236,9 @@ let modules_rules sctx kind expander ~dir scope modules =
     ~preprocessor_deps
     ~lint
     ~empty_module_interface_if_absent
+    ~ctypes
+    ~modules_loc
+    ~buildable_loc
     sctx
     expander
     ~dir

src/dune_rules/ctypes/ctypes_field.ml

@@ -91,15 +91,16 @@ end
 module Type_description = struct
   type t =
     { functor_ : Module_name.t
+    ; functor_loc : Loc.t
     ; instance : Module_name.t
     }
 
   let decode =
     let open Dune_lang.Decoder in
     fields
-      (let+ functor_ = field "functor" Module_name.decode
+      (let+ functor_loc, functor_ = located @@ field "functor" Module_name.decode
        and+ instance = field "instance" Module_name.decode in
-       { functor_; instance })
+       { functor_; functor_loc; instance })
   ;;
 end
 
@@ -108,6 +109,7 @@ module Function_description = struct
     { concurrency : Concurrency_policy.t
     ; errno_policy : Errno_policy.t
     ; functor_ : Module_name.t
+    ; functor_loc : Loc.t
     ; instance : Module_name.t
     }
 
@@ -116,11 +118,12 @@ module Function_description = struct
     fields
       (let+ concurrency = field_o "concurrency" Concurrency_policy.decode
        and+ errno_policy = field_o "errno_policy" Errno_policy.decode
-       and+ functor_ = field "functor" Module_name.decode
+       and+ functor_loc, functor_ = located @@ field "functor" Module_name.decode
        and+ instance = field "instance" Module_name.decode in
        { concurrency = Option.value concurrency ~default:Concurrency_policy.default
        ; errno_policy = Option.value errno_policy ~default:Errno_policy.default
        ; functor_
+       ; functor_loc
        ; instance
        })
   ;;

src/dune_rules/ctypes/ctypes_field.mli

@@ -36,6 +36,7 @@ end
 module Type_description : sig
   type t =
     { functor_ : Module_name.t
+    ; functor_loc : Loc.t
     ; instance : Module_name.t
     }
 end
@@ -45,6 +46,7 @@ module Function_description : sig
     { concurrency : Concurrency_policy.t
     ; errno_policy : Errno_policy.t
     ; functor_ : Module_name.t
+    ; functor_loc : Loc.t
     ; instance : Module_name.t
     }
 end

test/blackbox-tests/test-cases/ctypes/gh12018.t

@@ -43,61 +43,15 @@ Reproduction case for https://github.com/ocaml/dune/issues/12018
 
   $ LIBEX=$(realpath "$PWD/libexample")
   $ DYLD_LIBRARY_PATH="$LIBEX" LD_LIBRARY_PATH="$LIBEX" PKG_CONFIG_PATH="$LIBEX/pkgconfig" PKG_CONFIG_ARGN="--define-prefix" dune exec ./foo.exe
-  Internal error, please report upstream including the contents of _build/log.
-  Description:
-    ("link_many: unable to find module",
-     { main_module_name = "Libexample__type_gen"
-     ; modules =
-         Modules
-           (Singleton
-              { source =
-                  { path = [ "Foo" ]
-                  ; files =
-                      { impl =
-                          Some
-                            { path = In_build_dir "default/foo.ml"
-                            ; original_path = In_build_dir "default/foo.ml"
-                            ; dialect = "ocaml"
-                            }
-                      ; intf =
-                          Some
-                            { path = In_build_dir "default/foo.mli"
-                            ; original_path = In_build_dir "default/foo.mli"
-                            ; dialect = "ocaml"
-                            }
-                      }
-                  }
-              ; obj_name = "dune__exe__Foo"
-              ; pp = None
-              ; visibility = "public"
-              ; kind = "impl"
-              ; install_as = None
-              })
-     })
-  Raised at Stdune__Code_error.raise in file
-    "otherlibs/stdune/src/code_error.ml", line 10, characters 30-62
-  Called from Dune_rules__Exe.link_many.(fun) in file "src/dune_rules/exe.ml",
-    lines 312-316, characters 12-15
-  Called from Fiber__Scheduler.exec in file "src/fiber/src/scheduler.ml", line
-    76, characters 8-11
-  Re-raised at Stdune__Exn.raise_with_backtrace in file
-    "otherlibs/stdune/src/exn.ml", line 38, characters 27-56
-  Called from Fiber__Scheduler.exec in file "src/fiber/src/scheduler.ml", line
-    76, characters 8-11
-  Re-raised at Stdune__Exn.raise_with_backtrace in file
-    "otherlibs/stdune/src/exn.ml", line 38, characters 27-56
-  Called from Fiber__Scheduler.exec in file "src/fiber/src/scheduler.ml", line
-    76, characters 8-11
-  Re-raised at Stdune__Exn.raise_with_backtrace in file
-    "otherlibs/stdune/src/exn.ml", line 38, characters 27-56
-  Called from Fiber__Scheduler.exec in file "src/fiber/src/scheduler.ml", line
-    76, characters 8-11
-  -> required by ("<unnamed>", ())
-  -> required by ("load-dir", In_build_dir "default")
-  
-  I must not crash.  Uncertainty is the mind-killer. Exceptions are the
-  little-death that brings total obliteration.  I will fully express my cases. 
-  Execution will pass over me and through me.  And when it has gone past, I
-  will unwind the stack along its path.  Where the cases are handled there will
-  be nothing.  Only I will remain.
+  File "dune", line 3, characters 10-13:
+  3 |  (modules foo)
+                ^^^
+  Error: Module Function_description is required by ctypes at dune:13 but is
+  missing in the modules field of the stanza.
+  File "dune", line 3, characters 10-13:
+  3 |  (modules foo)
+                ^^^
+  Error: Module Type_description is required by ctypes at dune:10 but is
+  missing in the modules field of the stanza.
   [1]
+

test/blackbox-tests/test-cases/ctypes/github-5561-name-mangle.t

@@ -16,8 +16,16 @@
   > EOF
 
   $ bash -c 'set -o pipefail; dune build 2>&1 | head -n 20'
-  File "fooBar__type_gen.ml", line 3, characters 12-34:
-  3 |     (module Type_description.Types)
-                  ^^^^^^^^^^^^^^^^^^^^^^
-  Error: Unbound module Type_description
+  File "dune", lines 1-9, characters 0-211:
+  1 | (library
+  2 |  (name foo)
+  3 |  (ctypes
+  4 |   (external_library_name fooBar)
+  5 |   (build_flags_resolver vendored)
+  6 |   (generated_entry_point Types_generated2)
+  7 |   (type_description
+  8 |    (instance Type)
+  9 |    (functor Type_description))))
+  Error: Module Type_description is required by ctypes at dune:9 but is missing
+  in the modules field of the stanza.
   [1]