From f829b0d41659a1e7b9513dcfe7b31b9a8bf70891 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 12 Jan 2023 13:13:21 +0100 Subject: [PATCH] ctypes 0.3: run commands in stanza directory 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 --- CHANGES.md | 3 + src/dune_rules/ctypes/ctypes_field.ml | 10 +- src/dune_rules/ctypes/ctypes_field.mli | 1 + src/dune_rules/ctypes/ctypes_rules.ml | 121 +++++++++++------- src/dune_rules/ctypes/ctypes_rules.mli | 1 + src/dune_rules/exe_rules.ml | 4 +- src/dune_rules/lib_rules.ml | 4 +- .../test-cases/ctypes/directories.t | 10 ++ 8 files changed, 101 insertions(+), 53 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 21f63e0122a..e7227930e87 100644 --- a/CHANGES.md +++ b/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) ------------------ diff --git a/src/dune_rules/ctypes/ctypes_field.ml b/src/dune_rules/ctypes/ctypes_field.ml index 3fa0b6e98ec..c0c60d76f08 100644 --- a/src/dune_rules/ctypes/ctypes_field.ml +++ b/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 () = diff --git a/src/dune_rules/ctypes/ctypes_field.mli b/src/dune_rules/ctypes/ctypes_field.mli index d520e9d9de7..1a6f9e8fa44 100644 --- a/src/dune_rules/ctypes/ctypes_field.mli +++ b/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 diff --git a/src/dune_rules/ctypes/ctypes_rules.ml b/src/dune_rules/ctypes/ctypes_rules.ml index 18a6615fb30..7acca97ad98 100644 --- a/src/dune_rules/ctypes/ctypes_rules.ml +++ b/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 = diff --git a/src/dune_rules/ctypes/ctypes_rules.mli b/src/dune_rules/ctypes/ctypes_rules.mli index 875c4f98acc..8fbe66ff841 100644 --- a/src/dune_rules/ctypes/ctypes_rules.mli +++ b/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 : diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index a47f0b7ea70..079d86e0495 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -191,7 +191,7 @@ 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 @@ -199,7 +199,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info 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 diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 51db6734d66..424f74e8940 100644 --- a/src/dune_rules/lib_rules.ml +++ b/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 diff --git a/test/blackbox-tests/test-cases/ctypes/directories.t b/test/blackbox-tests/test-cases/ctypes/directories.t index 3870c4a6770..beafdf7f03c 100644 --- a/test/blackbox-tests/test-cases/ctypes/directories.t +++ b/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