ctypes 0.3: run commands in stanza directory (#6883)

This creates version 0.3 of the ctypes field.

When used, commands are run in the directory where the corresponding
stanza is defined. This makes it possible to use relative directories.

Fixes #5325

Signed-off-by: Etienne Millon <[email protected]>

CHANGES.md

@@ -124,6 +124,9 @@ Unreleased
   not set then the cinaps actions will be attached to both `@cinaps` and
   `@runtest` (#6988, @rgrinberg)
 
+- Add `(using ctypes 0.3)`. When used, paths in `(ctypes)` are interpreted
+  relative to where the stanza is defined. (#6883, fixes #5325, @emillon)
+
 3.6.2 (2022-12-21)
 ------------------
 

src/dune_rules/ctypes/ctypes_field.ml

@@ -5,7 +5,10 @@ let name = "ctypes"
 
 let syntax =
   Dune_lang.Syntax.create ~name ~desc:"the ctypes extension"
-    [ ((0, 1), `Since (3, 0)); ((0, 2), `Since (3, 4)) ]
+    [ ((0, 1), `Since (3, 0))
+    ; ((0, 2), `Since (3, 4))
+    ; ((0, 3), `Since (3, 7))
+    ]
 
 module Build_flags_resolver = struct
   module Vendored = struct
@@ -140,6 +143,7 @@ type t =
   ; generated_types : Module_name.t
   ; generated_entry_point : Module_name.t
   ; deps : Dep_conf.t list
+  ; version : Syntax.Version.t
   }
 
 type Stanza.t += T of t
@@ -157,7 +161,8 @@ let decode =
      and+ generated_types = field_o "generated_types" Module_name.decode
      and+ generated_entry_point =
        field "generated_entry_point" Module_name.decode
-     and+ deps = field_o "deps" (repeat Dep_conf.decode) in
+     and+ deps = field_o "deps" (repeat Dep_conf.decode)
+     and+ version = Syntax.get_exn syntax in
      let external_library_name =
        External_lib_name.of_string external_library_name
      in
@@ -187,6 +192,7 @@ let decode =
            ~default:(Module_name.of_string "Types_generated")
      ; generated_entry_point
      ; deps = Option.value ~default:[] deps
+     ; version
      })
 
 let () =

src/dune_rules/ctypes/ctypes_field.mli

@@ -58,6 +58,7 @@ type t =
   ; generated_types : Module_name.t
   ; generated_entry_point : Module_name.t
   ; deps : Dep_conf.t list
+  ; version : Syntax.Version.t
   }
 
 type Stanza.t += T of t

src/dune_rules/ctypes/ctypes_rules.ml

@@ -155,7 +155,7 @@ let function_gen_gen ~expander
        ])
 
 let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope
-    ~cflags ~output ~deps =
+    ~cflags ~output ~deps ~version =
   let ctx = Super_context.context sctx in
   let open Memo.O in
   let* exe =
@@ -169,36 +169,39 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope
         Dune_project.use_standard_c_and_cxx_flags project
       in
       let cfg = ctx.ocaml_config in
+      let fdo_flags = Command.Args.As (Fdo.c_flags ctx) in
       match use_standard_flags with
-      | Some true -> Fdo.c_flags ctx
+      | Some true -> fdo_flags
       | None | Some false ->
         (* In dune < 2.8 flags from ocamlc_config are always added *)
-        List.concat
-          [ Ocaml_config.ocamlc_cflags cfg
-          ; Ocaml_config.ocamlc_cppflags cfg
-          ; Fdo.c_flags ctx
+        S
+          [ As (Ocaml_config.ocamlc_cflags cfg)
+          ; As (Ocaml_config.ocamlc_cppflags cfg)
+          ; fdo_flags
           ]
     in
     let open Action_builder.O in
     let* expander = Action_builder.of_memo (Super_context.expander sctx ~dir) in
-    Super_context.foreign_flags sctx ~dir ~expander
-      ~flags:Ordered_set_lang.Unexpanded.standard ~language:C
-    |> Action_builder.map ~f:(List.append base_flags)
+    let+ foreign_flags =
+      Super_context.foreign_flags sctx ~dir ~expander
+        ~flags:Ordered_set_lang.Unexpanded.standard ~language:C
+    in
+    Command.Args.S [ base_flags; As foreign_flags ]
   in
   let include_args =
-    let ocaml_where = Path.to_string ctx.stdlib_dir in
+    let ocaml_where = ctx.stdlib_dir in
     (* XXX: need glob dependency *)
-    let open Resolve.Memo.O in
-    let+ ctypes_include_dirs =
-      let+ lib =
-        let ctypes = Lib_name.of_string "ctypes" in
-        Lib.DB.resolve (Scope.libs scope) (Loc.none, ctypes)
-      in
-      Lib_flags.L.include_paths [ lib ] (Ocaml Native)
-      |> Path.Set.to_list_map ~f:Path.to_string
+    let open Action_builder.O in
+    let ctypes = Lib_name.of_string "ctypes" in
+    let+ lib =
+      Lib.DB.resolve (Scope.libs scope) (Loc.none, ctypes) |> Resolve.Memo.read
+    in
+    let ctypes_include_dirs =
+      Lib_flags.L.include_paths [ lib ] (Ocaml Native) |> Path.Set.to_list
     in
     let include_dirs = ocaml_where :: ctypes_include_dirs in
-    List.concat_map include_dirs ~f:(fun dir -> [ "-I"; dir ])
+    Command.Args.S
+      (List.map include_dirs ~f:(fun dir -> Command.Args.S [ A "-I"; Path dir ]))
   in
   let deps =
     let source_file_deps =
@@ -216,33 +219,57 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope
     in
     deps
   in
-  let build =
-    let absolute_path_hack p =
-      (* These normal path builder things construct relative paths like
-         _build/default/your/project/file.c but before dune runs gcc it actually
-         cds into _build/default, which fails, so we turn them into absolutes to
-         hack around it. *)
-      Path.relative (Path.build dir) p |> Path.to_absolute_filename
-    in
-    let action =
-      let open Action_builder.O in
-      let* include_args = Resolve.Memo.read include_args in
-      let* base_args = with_user_and_std_flags in
-      deps
-      >>> Action_builder.map cflags ~f:(fun cflags_args ->
-              let source_files = List.map source_files ~f:absolute_path_hack in
-              let output = absolute_path_hack output in
-              let args =
-                base_args @ cflags_args @ include_args @ source_files
-                @ [ "-o"; output ]
-              in
-              Action.run exe args)
-    in
-    Action_builder.with_file_targets action
-      ~file_targets:[ Path.Build.relative dir output ]
+  let all_flags =
+    Command.Args.S
+      [ Dyn with_user_and_std_flags
+      ; Dyn (Action_builder.map cflags ~f:(fun l -> Command.Args.As l))
+      ; Dyn include_args
+      ]
+  in
+  let action =
+    if version >= (0, 3) then
+      let args =
+        [ Command.Args.as_any all_flags
+        ; Deps
+            (List.map
+               ~f:(fun s -> Path.relative (Path.build dir) s)
+               source_files)
+        ; A "-o"
+        ; Target (Path.Build.relative dir output)
+        ]
+      in
+      let open Action_builder.With_targets.O in
+      Action_builder.with_no_targets deps
+      >>> Command.run ~dir:(Path.build dir) exe args
+    else
+      let build =
+        let absolute_path_hack p =
+          (* These normal path builder things construct relative paths like
+             _build/default/your/project/file.c but before dune runs gcc it actually
+             cds into _build/default, which fails, so we turn them into absolutes to
+             hack around it. *)
+          Path.relative (Path.build dir) p |> Path.to_absolute_filename
+        in
+        let action =
+          let open Action_builder.O in
+          let* flag_args =
+            Command.expand_no_targets ~dir:(Path.build dir) all_flags
+          in
+          let+ () = deps in
+          let source_files = List.map source_files ~f:absolute_path_hack in
+          let output = absolute_path_hack output in
+          let args = flag_args @ source_files @ [ "-o"; output ] in
+          (* TODO: it might be possible to convert this to Command.run and
+             consolidate both branches but it is also possible that we drop
+             support for < 0.3 instead *)
+          Action.run exe args
+        in
+        Action_builder.with_file_targets action
+          ~file_targets:[ Path.Build.relative dir output ]
+      in
+      Action_builder.With_targets.map ~f:Action.Full.make build
   in
-  Super_context.add_rule sctx ~dir
-    (Action_builder.With_targets.map ~f:Action.Full.make build)
+  Super_context.add_rule sctx ~dir action
 
 let program_of_module_and_dir ~dir program =
   let build_dir = Path.build dir in
@@ -261,7 +288,7 @@ let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps =
   Exe.link_many ~link_args ~programs:[ program ]
     ~linkages:[ Exe.Linkage.native ] ~promote:None shared_cctx ~sandbox
 
-let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx =
+let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx ~version =
   let ctypes = Option.value_exn buildable.ctypes in
   let external_library_name = ctypes.external_library_name in
   let type_description_functor = ctypes.type_description.functor_ in
@@ -359,7 +386,7 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx =
     let* () =
       build_c_program ~foreign_archives_deps ~sctx ~dir ~scope
         ~source_files:[ c_generated_types_cout_c ]
-        ~output:c_generated_types_cout_exe ~deps ~cflags
+        ~output:c_generated_types_cout_exe ~deps ~cflags ~version
     in
     Super_context.add_rule sctx ~loc:Loc.none ~dir
       (let stdout_to =

src/dune_rules/ctypes/ctypes_rules.mli

@@ -7,6 +7,7 @@ val gen_rules :
   -> scope:Scope.t
   -> dir:Path.Build.t
   -> sctx:Super_context.t
+  -> version:Syntax.Version.t
   -> unit Memo.t
 
 val ctypes_cclib_flags :

src/dune_rules/exe_rules.ml

@@ -191,15 +191,15 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
     | None ->
       Exe.build_and_link_many cctx ~programs ~linkages ~link_args ~o_files
         ~promote:exes.promote ~embed_in_plugin_libraries ~sandbox
-    | Some _ctypes ->
+    | Some { version; _ } ->
       (* Ctypes stubgen builds utility .exe files that need to share modules
          with this compilation context. To support that, we extract the one-time
          run bits from [Exe.build_and_link_many] and run them here, then pass
          that to the [Exe.link_many] call here as well as the Ctypes_rules. This
          dance is done to avoid triggering duplicate rule exceptions. *)
       let* () =
         let loc = fst (List.hd exes.Executables.names) in
-        Ctypes_rules.gen_rules ~cctx ~buildable ~loc ~sctx ~scope ~dir
+        Ctypes_rules.gen_rules ~cctx ~buildable ~loc ~sctx ~scope ~dir ~version
       in
       let* () = Module_compilation.build_all cctx in
       Exe.link_many ~programs ~linkages ~link_args ~o_files

src/dune_rules/lib_rules.ml

@@ -561,9 +561,9 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope =
     let* () =
       match buildable.ctypes with
       | None -> Memo.return ()
-      | Some _ctypes ->
+      | Some { version; _ } ->
         Ctypes_rules.gen_rules ~loc:(fst lib.name) ~cctx ~buildable ~sctx ~scope
-          ~dir
+          ~dir ~version
     in
     library_rules lib ~local_lib ~cctx ~source_modules ~dir_contents
       ~compile_info

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

@@ -74,3 +74,13 @@ We ensure that just `-I lib` or `-I .` are not enough on their own.
   $ echo "(-I .)" > lib/extra_flags.sexp
   $ dune build > /dev/null 2>&1
   [1]
+
+With 0.3, everything is relative to the directory.
+
+  $ cat > dune-project << EOF
+  > (lang dune 3.7)
+  > (using ctypes 0.3)
+  > EOF
+
+  $ echo "(-I .)" > lib/extra_flags.sexp
+  $ dune build