matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

wrapped transition mode 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-27 18:36:05 +03:00
parent 2cd796f405
commit d1d7672e96
24 changed files with 216 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/compilation_context.ml
View File

@ -105,3 +105,6 @@ let for_alias_module t =
; includes = Includes.empty
; alias_module = None
}
let set_modules t modules =
{ t with modules }

2
src/compilation_context.mli
View File

@ -48,3 +48,5 @@ val includes : t -> string list Arg_spec.t Cm_kind.Dict.t
val preprocessing : t -> Preprocessing.t
val no_keep_locs : t -> bool
val opaque : t -> bool
val set_modules : t -> Module.t Module.Name.Map.t -> t

22
src/dir_contents.ml
View File

@ -168,6 +168,7 @@ module Library_modules : sig
{ modules : Module.t Module.Name.Map.t
; alias_module : Module.t option
; main_module_name : Module.Name.t
; deprecated : Module.t Module.Name.Map.t
}
val make : Library.t -> dir:Path.t -> Module.t Module.Name.Map.t -> t
@ -176,25 +177,32 @@ end = struct
{ modules : Module.t Module.Name.Map.t
; alias_module : Module.t option
; main_module_name : Module.Name.t
; deprecated : Module.t Module.Name.Map.t
}
let make (lib : Library.t) ~dir (modules : Module.t Module.Name.Map.t) =
let main_module_name =
Module.Name.of_string (Lib_name.Local.to_string lib.name) in
let modules =
if not lib.wrapped then
modules
else
let (modules, deprecated) =
let wrap_modules modules =
let open Module.Name.Infix in
Module.Name.Map.map modules ~f:(fun m ->
Module.Name.Map.map modules ~f:(fun (m : Module.t) ->
if m.name = main_module_name then
m
else
Module.with_wrapper m ~libname:lib.name)
in
match lib.wrapped with
| Simple false -> (modules, Module.Name.Map.empty)
| Simple true -> (wrap_modules modules, Module.Name.Map.empty)
| Yes_with_transition _ ->
( wrap_modules modules
, Module.Name.Map.map ~f:Module.deprecate modules
)
in
let alias_module =
let lib_name = Lib_name.Local.to_string lib.name in
if not lib.wrapped ||
if not (Library.Wrapped.to_bool lib.wrapped) ||
(Module.Name.Map.cardinal modules = 1 &&
Module.Name.Map.mem modules main_module_name) then
None
@ -215,7 +223,7 @@ end = struct
(Path.relative dir (lib_name ^ ".ml-gen")))
~obj_name:lib_name)
in
{ modules; alias_module; main_module_name }
{ modules; alias_module; main_module_name; deprecated }
end
module Executables_modules = struct

1
src/dir_contents.mli
View File

@ -21,6 +21,7 @@ module Library_modules : sig
{ modules : Module.t Module.Name.Map.t
; alias_module : Module.t option
; main_module_name : Module.Name.t
; deprecated : Module.t Module.Name.Map.t
}
end

25
src/dune_file.ml
View File

@ -859,6 +859,25 @@ module Library = struct
syntax
end
module Wrapped = struct
type t =
| Simple of bool
| Yes_with_transition of string
let dparse =
if_list
~then_:(
Syntax.since Stanza.syntax (1, 2) >>= fun () ->
sum ["transition_until", string >>| fun x -> Yes_with_transition x])
~else_:(bool >>| fun w -> Simple w)
let field = field "wrapped" ~default:(Simple true) dparse
let to_bool = function
| Simple b -> b
| Yes_with_transition _ -> true
end
type t =
{ name : Lib_name.Local.t
; public : Public_lib.t option
@ -875,7 +894,7 @@ module Library = struct
; c_library_flags : Ordered_set_lang.Unexpanded.t
; self_build_stubs_archive : string option
; virtual_deps : (Loc.t * Lib_name.t) list
; wrapped : bool
; wrapped : Wrapped.t
; optional : bool
; buildable : Buildable.t
; dynlink : Dynlink_supported.t
@ -908,7 +927,7 @@ module Library = struct
field "virtual_deps" (list (located Lib_name.dparse)) ~default:[]
and modes = field "modes" Mode_conf.Set.dparse ~default:Mode_conf.Set.default
and kind = field "kind" Kind.dparse ~default:Kind.Normal
and wrapped = field "wrapped" bool ~default:true
and wrapped = Wrapped.field
and optional = field_b "optional"
and self_build_stubs_archive =
field "self_build_stubs_archive" (option string) ~default:None
@ -932,7 +951,7 @@ module Library = struct
let open Syntax.Version.Infix in
match name, public with
| Some n, _ ->
Lib_name.Local.validate n ~wrapped
Lib_name.Local.validate n ~wrapped:(Wrapped.to_bool wrapped)
| None, Some { name = (loc, name) ; _ } ->
if dune_version >= (1, 1) then
match Lib_name.to_local name with

10
src/dune_file.mli
View File

@ -216,6 +216,14 @@ module Library : sig
| Ppx_rewriter
end
module Wrapped : sig
type t =
| Simple of bool
| Yes_with_transition of string
val to_bool : t -> bool
end
type t =
{ name : Lib_name.Local.t
; public : Public_lib.t option
@ -232,7 +240,7 @@ module Library : sig
; c_library_flags : Ordered_set_lang.Unexpanded.t
; self_build_stubs_archive : string option
; virtual_deps : (Loc.t * Lib_name.t) list
; wrapped : bool
; wrapped : Wrapped.t
; optional : bool
; buildable : Buildable.t
; dynlink : Dynlink_supported.t

7
src/install_rules.ml
View File

@ -138,7 +138,8 @@ module Gen(P : Params) = struct
let if_ cond l = if cond then l else [] in
let files =
let modules =
let { Dir_contents.Library_modules.modules; alias_module; _ } =
let { Dir_contents.Library_modules.modules; alias_module; deprecated
; main_module_name = _ } =
Dir_contents.modules_of_library dir_contents
~name:(Library.best_name lib)
in
@ -147,7 +148,9 @@ module Gen(P : Params) = struct
| None -> modules
| Some m -> Module.Name.Map.add modules m.name m
in
Module.Name.Map.values modules
List.rev_append
(Module.Name.Map.values modules)
(Module.Name.Map.values deprecated)
in
let virtual_library = Library.is_virtual lib in
List.concat

8
src/js_of_ocaml_rules.ml
View File

@ -113,15 +113,15 @@ let link_rule cc ~runtime ~target =
; Arg_spec.Dyn get_all
]
let build_cm cc ~(js_of_ocaml:Dune_file.Js_of_ocaml.t) ~src ~target =
let sctx = Compilation_context.super_context cc in
let dir = Compilation_context.dir cc in
let build_cm cctx ~(js_of_ocaml:Dune_file.Js_of_ocaml.t) ~src ~target =
let sctx = Compilation_context.super_context cctx in
let dir = Compilation_context.dir cctx in
if separate_compilation_enabled sctx
then
let itarget = Path.extend_basename src ~suffix:".js" in
let spec = Arg_spec.Dep src in
let flags =
let scope = Compilation_context.scope cc in
let scope = Compilation_context.scope cctx in
SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
~standard:(Build.return (standard sctx))
in

65
src/lib_rules.ml
View File

@ -120,6 +120,37 @@ module Gen (P : Install_rules.Params) = struct
~sandbox:alias_module_build_sandbox
~dep_graphs:(Ocamldep.Dep_graphs.dummy m)
let build_deprecated_modules (lib : Library.t)
cctx
~modules
~js_of_ocaml
~dynlink
~(deprecated : Module.t Module.Name.Map.t) =
let lib_name = String.capitalize (Lib_name.Local.to_string lib.name) in
let transition_until =
match lib.wrapped with
| Simple _ -> "" (* will never be accessed anyway *)
| Yes_with_transition r -> r
in
Module.Name.Map.iteri deprecated ~f:(fun name m ->
let contents =
let name = Module.Name.to_string name in
let hidden_name = sprintf "%s__%s" lib_name name in
let real_name = sprintf "%s.%s" lib_name name in
sprintf "include %s [@@deprecated \"%s is not guaranteed past %s. \
Use %s instead.\"]"
hidden_name name transition_until real_name
in
let source_path = Option.value_exn (Module.file m Impl) in
Build.return contents
>>> Build.write_file_dyn source_path
|> SC.add_rule sctx
);
let dep_graphs =
Ocamldep.Dep_graphs.deprecated ~modules ~deprecated in
let cctx = Compilation_context.set_modules cctx deprecated in
Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs
let build_c_file (lib : Library.t) ~scope ~dir ~includes (src, dst) =
SC.add_rule sctx
(SC.expand_and_eval_set sctx ~scope ~dir lib.c_flags
@ -293,7 +324,7 @@ module Gen (P : Install_rules.Params) = struct
in
let flags = SC.ocaml_flags sctx ~scope ~dir lib.buildable in
let { Dir_contents.Library_modules.
modules; main_module_name; alias_module } =
modules; main_module_name; alias_module ; deprecated } =
Dir_contents.modules_of_library dir_contents ~name:(Library.best_name lib)
in
let source_modules = modules in
@ -318,7 +349,7 @@ module Gen (P : Install_rules.Params) = struct
in
let lib_interface_module =
if lib.wrapped then
if Library.Wrapped.to_bool lib.wrapped then
Module.Name.Map.find modules main_module_name
else
None
@ -340,12 +371,16 @@ module Gen (P : Install_rules.Params) = struct
~opaque
in
let dep_graphs = Ocamldep.rules cctx in
let dynlink =
Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries
in
let js_of_ocaml = lib.buildable.js_of_ocaml in
build_deprecated_modules lib cctx ~dynlink ~js_of_ocaml
~deprecated ~modules;
let dep_graphs = Ocamldep.rules cctx in
Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs;
Option.iter alias_module
@ -355,15 +390,17 @@ module Gen (P : Install_rules.Params) = struct
if Library.has_stubs lib then
build_stubs lib ~dir ~scope ~requires ~dir_contents;
let add_cms ~cm_kind ~init = Module.Name.Map.fold ~init ~f:(fun m acc ->
match Module.cm_file m ~obj_dir cm_kind with
| None -> acc
| Some fn -> Path.Set.add acc fn)
in
List.iter Cm_kind.all ~f:(fun cm_kind ->
let files =
Module.Name.Map.fold modules ~init:Path.Set.empty ~f:(fun m acc ->
match Module.cm_file m ~obj_dir cm_kind with
| None -> acc
| Some fn -> Path.Set.add acc fn)
in
let files = add_cms ~cm_kind ~init:Path.Set.empty modules in
let files = add_cms ~cm_kind ~init:files deprecated in
SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:(Cm_kind.ext cm_kind)
files);
SC.Libs.setup_file_deps_group_alias sctx ~dir lib ~exts:[".cmi"; ".cmx"];
SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:".h"
(List.map lib.install_c_headers ~f:(fun header ->
@ -377,12 +414,16 @@ module Gen (P : Install_rules.Params) = struct
else
acc)
in
let deprecated_modules = Module.Name.Map.values deprecated in
(* deprecated modules have implementations so we can just append them *)
let top_sorted_modules =
Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl modules
>>^ fun modules -> modules @ deprecated_modules
in
List.iter Mode.all ~f:(fun mode ->
(let modules = modules @ deprecated_modules in
List.iter Mode.all ~f:(fun mode ->
build_lib lib ~scope ~flags ~dir ~obj_dir ~mode ~top_sorted_modules
~modules));
~modules)));
(* Build *.cma.js *)
SC.add_rules sctx (
let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in

36
src/module.ml
View File

@ -32,6 +32,12 @@ end
module Syntax = struct
type t = OCaml | Reason
let to_sexp =
let open Sexp.To_sexp in
function
| OCaml -> string "OCaml"
| Reason -> string "Reason"
end
module File = struct
@ -41,6 +47,13 @@ module File = struct
}
let make syntax path = { syntax; path }
let to_sexp { path; syntax } =
let open Sexp.To_sexp in
record
[ "path", Path.to_sexp path
; "syntax", Syntax.to_sexp syntax
]
end
type t =
@ -140,3 +153,26 @@ let dir t =
Path.parent_exn file.path
let set_pp t pp = { t with pp }
let to_sexp { name; impl; intf; obj_name ; pp } =
let open Sexp.To_sexp in
record
[ "name", Name.to_sexp name
; "obj_name", string obj_name
; "impl", (option File.to_sexp) impl
; "intf", (option File.to_sexp) intf
; "pp", (option string) (Option.map ~f:(fun _ -> "has pp") pp)
]
let deprecate t =
{ t with
intf = None
; impl =
Some (
let impl = Option.value_exn t.impl in
let (base, _) = Path.split_extension impl.path in
{ syntax = OCaml
; path = Path.extend_basename base ~suffix:".ml-gen"
}
)
}

4
src/module.mli
View File

@ -92,3 +92,7 @@ val with_wrapper : t -> libname:Lib_name.Local.t -> t
val map_files : t -> f:(Ml_kind.t -> File.t -> File.t) -> t
val set_pp : t -> (unit, string list) Build.t option -> t
val to_sexp : t Sexp.To_sexp.t
val deprecate : t -> t

17
src/ocamldep.ml
View File

@ -51,6 +51,20 @@ module Dep_graph = struct
{ dir = Path.root
; per_module = Module.Name.Map.singleton m.name (Build.return [])
}
let deprecated ~modules ~deprecated =
{ dir = Path.root
; per_module = Module.Name.Map.merge deprecated modules ~f:(fun _ d m ->
match d, m with
| None, None -> assert false
| Some deprecated, None ->
Exn.code_error "deprecated module needs counterpart"
[ "deprecated", Module.to_sexp deprecated
]
| None, Some _ -> None
| Some _, Some m -> Some (Build.return [m])
)
}
end
module Dep_graphs = struct
@ -58,6 +72,9 @@ module Dep_graphs = struct
let dummy m =
Ml_kind.Dict.make_both (Dep_graph.dummy m)
let deprecated ~modules ~deprecated =
Ml_kind.Dict.make_both (Dep_graph.deprecated ~modules ~deprecated)
end
let parse_module_names ~(unit : Module.t) ~modules words =

5
src/ocamldep.mli
View File

@ -18,6 +18,11 @@ module Dep_graphs : sig
type t = Dep_graph.t Ml_kind.Dict.t
val dummy : Module.t -> t
val deprecated
: modules:Module.t Module.Name.Map.t
-> deprecated:Module.t Module.Name.Map.t
-> t
end
(** Generate ocamldep rules for all the modules in the context. *)

2
src/stanza.ml
View File

@ -9,7 +9,7 @@ end
let syntax =
Syntax.create ~name:"dune" ~desc:"the dune language"
[ (0, 0) (* Jbuild syntax *)
; (1, 1)
; (1, 2)
]
module File_kind = struct

14
test/blackbox-tests/dune.inc
View File

@ -836,6 +836,14 @@
test-cases/workspaces
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name wrapped-transition)
(deps (package dune) (source_tree test-cases/wrapped-transition))
(action
(chdir
test-cases/wrapped-transition
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
(alias
(name runtest)
(deps
@ -938,7 +946,8 @@
(alias utop-default)
(alias variants)
(alias windows-diff)
(alias workspaces)))
(alias workspaces)
(alias wrapped-transition)))
(alias
(name runtest-no-deps)
@ -1029,7 +1038,8 @@
(alias utop-default)
(alias variants)
(alias windows-diff)
(alias workspaces)))
(alias workspaces)
(alias wrapped-transition)))
(alias (name runtest-disabled) (deps (alias envs-and-contexts)))

6
test/blackbox-tests/test-cases/dune-project-edition/run.t
View File

@ -3,9 +3,9 @@
$ mkdir src
$ echo '(alias (name runtest) (action (progn)))' > src/dune
$ dune build
Info: creating file dune-project with this contents: (lang dune 1.1)
Info: creating file dune-project with this contents: (lang dune 1.2)
$ cat dune-project
(lang dune 1.1)
(lang dune 1.2)
Test that using menhir automatically update the dune-project file
@ -13,5 +13,5 @@ Test that using menhir automatically update the dune-project file
$ dune build
Info: appending this line to dune-project: (using menhir 1.0)
$ cat dune-project
(lang dune 1.1)
(lang dune 1.2)
(using menhir 1.0)

2
test/blackbox-tests/test-cases/no-name-field/run.t
View File

@ -37,7 +37,7 @@ there's only a public name which is invalid, but sine the library is unwrapped,
it's just a warning
$ dune build --root public-name-invalid-wrapped-false
Info: creating file dune-project with this contents: (lang dune 1.1)
Info: creating file dune-project with this contents: (lang dune 1.2)
File "dune", line 3, characters 14-21:
(public_name foo.bar))
^^^^^^^

7
test/blackbox-tests/test-cases/wrapped-transition/dune Normal file
View File

@ -0,0 +1,7 @@
(executable
(name fooexe)
(libraries mylib))
(alias
(name default)
(action (run ./fooexe.exe)))

1
test/blackbox-tests/test-cases/wrapped-transition/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.2)

4
test/blackbox-tests/test-cases/wrapped-transition/fooexe.ml Normal file
View File

@ -0,0 +1,4 @@
Mylib.Bar.run ();;
Mylib.Foo.run ();;
Bar.run ();;
Foo.run ();;

1
test/blackbox-tests/test-cases/wrapped-transition/lib/bar.ml Normal file
View File

@ -0,0 +1 @@
let run () = print_endline "bar"

3
test/blackbox-tests/test-cases/wrapped-transition/lib/dune Normal file
View File

@ -0,0 +1,3 @@
(library
(name mylib)
(wrapped (transition_until "2020-20-20")))

1
test/blackbox-tests/test-cases/wrapped-transition/lib/foo.ml Normal file
View File

@ -0,0 +1 @@
let run () = print_endline "foo"

6
test/blackbox-tests/test-cases/wrapped-transition/run.t Normal file
View File

@ -0,0 +1,6 @@
$ dune build
fooexe alias default
bar
foo
bar
foo