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

Merge pull request #359 from rgrinberg/lint2 

Implement lint field and run linting with @lint alias.
This commit is contained in:
Rudi Grinberg 2018-01-11 00:01:25 +08:00 committed by GitHub
parent 469079f9c6 f490540538
commit 9ed300e5a2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 243 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/alias.ml
View File

@ -113,6 +113,7 @@ let default = make "DEFAULT"
let runtest = make "runtest"
let install = make "install"
let doc = make "doc"
let lint = make "lint"
module Store = struct
type entry =
@ -183,3 +184,19 @@ let rules store =
(Path.Set.elements deps))))
in
rule :: acc)
let add_stamp_dep (store: Store.t) (t : t) ~data =
let digest = Digest.string (Sexp.to_string data) in
let digest_path = file_with_digest_suffix t ~digest in
add_deps store t [digest_path];
digest_path
let add_action_dep (store: Store.t) (t : t) ~action ~action_deps =
let data =
let deps = Sexp.To_sexp.list Jbuild.Dep_conf.sexp_of_t action_deps in
let action =
match action with
| None -> Sexp.Atom "none"
| Some a -> List [Atom "some"; Action.Unexpanded.sexp_of_t a] in
Sexp.List [deps ; action] in
add_stamp_dep store t ~data

19
src/alias.mli
View File

@ -26,6 +26,7 @@ val default : dir:Path.t -> t
val runtest : dir:Path.t -> t
val install : dir:Path.t -> t
val doc : dir:Path.t -> t
val lint : dir:Path.t -> t
val dep : t -> ('a, 'a) Build.t
@ -69,3 +70,21 @@ end
val add_deps : Store.t -> t -> Path.t list -> unit
val rules : Store.t -> Build_interpret.Rule.t list
(** Create an alias dependency for an action and its inputs represented by
[~data]. The path returned is the file that should be represented by the
file the action will create following execution.*)
val add_stamp_dep
: Store.t
-> t
-> data:Sexp.t
-> Path.t
(** Like [add_stamp_dep] but an action (if present) and the dependencies can be
passed in directly. *)
val add_action_dep
: Store.t
-> t
-> action:Action.Unexpanded.t option
-> action_deps:Jbuild.Dep_conf.t list
-> Path.t

34
src/gen_rules.ml
View File

@ -228,13 +228,15 @@ module Gen(P : Params) = struct
| Some m -> String_map.add modules ~key:m.name ~data:m
in
String_map.values modules);
(* Preprocess before adding the alias module as it doesn't need preprocessing *)
let modules =
SC.PP.pped_modules sctx ~dir ~dep_kind ~modules ~preprocess:lib.buildable.preprocess
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
~preprocess:lib.buildable.preprocess
~preprocessor_deps:lib.buildable.preprocessor_deps
~lib_name:(Some lib.name)
~scope
in
~lint:lib.buildable.lint
~lib_name:(Some lib.name) in
let modules =
match alias_module with
| None -> modules
@ -501,13 +503,15 @@ module Gen(P : Params) = struct
if not (String_map.mem (String.capitalize_ascii name) modules) then
die "executable %s in %s doesn't have a corresponding .ml file"
name (Path.to_string dir));
let modules =
SC.PP.pped_modules sctx ~dir ~dep_kind ~modules
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
~preprocess:exes.buildable.preprocess
~preprocessor_deps:exes.buildable.preprocessor_deps
~lint:exes.buildable.lint
~lib_name:None
~scope
in
let item = List.hd exes.names in
let dep_graph =
Ocamldep.rules sctx ~dir ~item ~modules ~alias_module:None
@ -570,21 +574,11 @@ module Gen(P : Params) = struct
~scope)
let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope =
let digest =
let deps =
Sexp.To_sexp.list Dep_conf.sexp_of_t alias_conf.deps in
let action =
match alias_conf.action with
| None -> Sexp.Atom "none"
| Some a -> List [Atom "some" ; Action.Unexpanded.sexp_of_t a]
in
Sexp.List [deps ; action]
|> Sexp.to_string
|> Digest.string
in
let alias = Alias.make alias_conf.name ~dir in
let digest_path = Alias.file_with_digest_suffix alias ~digest in
Alias.add_deps (SC.aliases sctx) alias [digest_path];
let digest_path =
Alias.add_action_dep (SC.aliases sctx) alias
~action:alias_conf.action
~action_deps:alias_conf.deps in
let deps = SC.Deps.interpret sctx ~scope ~dir alias_conf.deps in
SC.add_rule sctx
~locks:(interpret_locks ~dir ~scope alias_conf.locks)

5
src/import.ml
View File

@ -78,6 +78,11 @@ module List = struct
max acc (String.length (f x)))
let longest l = longest_map l ~f:(fun x -> x)
let rec last = function
| [] -> None
| [x] -> Some x
| _::xs -> last xs
end
module Hashtbl = struct

18
src/jbuild.ml
View File

@ -301,14 +301,12 @@ module Preprocess_map = struct
end
module Lint = struct
type t = Pps of Preprocess.pps
type t = Preprocess_map.t
let t =
sum
[ cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
let pps, flags = Pp_or_flags.split l in
Pps { pps; flags })
]
let t = Preprocess_map.t
let default = Preprocess_map.default
let no_lint = default
end
let field_oslu name =
@ -442,6 +440,7 @@ module Buildable = struct
; libraries : Lib_dep.t list
; preprocess : Preprocess_map.t
; preprocessor_deps : Dep_conf.t list
; lint : Preprocess_map.t
; flags : Ordered_set_lang.Unexpanded.t
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
@ -456,8 +455,8 @@ module Buildable = struct
>>= fun preprocessor_deps ->
(* CR-someday jdimino: remove this. There are still a few Jane Street packages using
this *)
field_o "lint" (Per_module.t Lint.t)
>>= fun _lint ->
field "lint" Lint.t ~default:Lint.default
>>= fun lint ->
field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii)
~default:Ordered_set_lang.standard
>>= fun modules ->
@ -470,6 +469,7 @@ module Buildable = struct
return
{ preprocess
; preprocessor_deps
; lint
; modules
; libraries
; flags

8
src/jbuild.mli
View File

@ -57,6 +57,13 @@ module Preprocess_map : sig
val pps : t -> Pp.t list
end
module Lint : sig
type t = Preprocess_map.t
val no_lint : t
end
module Js_of_ocaml : sig
type t =
{ flags : Ordered_set_lang.Unexpanded.t
@ -108,6 +115,7 @@ module Buildable : sig
; libraries : Lib_dep.t list
; preprocess : Preprocess_map.t
; preprocessor_deps : Dep_conf.t list
; lint : Lint.t
; flags : Ordered_set_lang.Unexpanded.t
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t

4
src/module.ml
View File

@ -54,3 +54,7 @@ let cmti_file t ~dir =
match t.intf with
| None -> Path.relative dir (t.obj_name ^ ".cmt")
| Some _ -> Path.relative dir (t.obj_name ^ ".cmti")
let iter t ~f =
f Ml_kind.Impl t.impl;
Option.iter t.intf ~f:(f Ml_kind.Intf)

2
src/module.mli
View File

@ -35,3 +35,5 @@ val odoc_file : t -> dir:Path.t -> Path.t
(** Either the .cmti, or .cmt if the module has no interface *)
val cmti_file : t -> dir:Path.t -> Path.t
val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit

5
src/path.ml
View File

@ -220,7 +220,10 @@ end
type t = string
let compare = String.compare
module Set = String_set
module Set = struct
include String_set
let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.elements t)
end
module Map = String_map
module Kind = struct

5
src/path.mli
View File

@ -39,7 +39,10 @@ val sexp_of_t : t Sexp.To_sexp.t
val compare : t -> t -> int
(** a directory is smaller than its descendants *)
module Set : Set.S with type elt = t
module Set : sig
include Set.S with type elt = t
val sexp_of_t : t Sexp.To_sexp.t
end
module Map : Map.S with type key = t
val kind : t -> Kind.t

144
src/super_context.ml
View File

@ -887,53 +887,119 @@ module PP = struct
mli) in
{ m with impl ; intf }
let lint_module sctx ~(source : Module.t) ~(ast : Module.t) ~dir
~dep_kind ~lint ~lib_name ~scope =
let alias = Alias.lint ~dir in
match Preprocess_map.find source.name lint with
| No_preprocessing -> ()
| Action action ->
let action = Action.U.Chdir (root_var, action) in
Module.iter source ~f:(fun _ (src : Module.File.t) ->
let digest_path =
Alias.add_action_dep
~action:(Some action)
~action_deps:[Dep_conf.File (String_with_vars.virt __POS__ src.name)]
(aliases sctx) alias in
let src = Path.relative dir src.name in
add_rule sctx
(Build.path src
>>^ (fun _ -> [src])
>>>
Build.progn
[ Action.run sctx
action
~dir
~dep_kind
~targets:(Static [])
~scope
; Build.create_file digest_path
])
)
| Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
Module.iter ast ~f:(fun kind src ->
let src_path = Path.relative dir src.name in
let args =
[ Arg_spec.As flags
; As (cookie_library_name lib_name)
; Ml_kind.ppx_driver_flag kind
; Dep src_path
] in
let args =
(* This hack is needed until -null is standard:
https://github.com/ocaml-ppx/ocaml-migrate-parsetree/issues/35 *)
match Option.map ~f:Pp.to_string (List.last pps) with
| Some "ppx_driver.runner" -> args @ [A "-null"]
| Some _ | None -> args in
let digest_path =
Alias.add_stamp_dep (aliases sctx) alias
~data:(
Sexp.To_sexp.(
triple Path.sexp_of_t string (pair (list string) Path.Set.sexp_of_t)
) (ppx_exe, src.name, Arg_spec.expand ~dir args ())
) in
add_rule sctx
(Build.progn
[ Build.run ~context:sctx.context (Ok ppx_exe) args
; Build.create_file digest_path
])
)
(* Generate rules to build the .pp files and return a new module map where all filenames
point to the .pp files *)
let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name
~scope =
let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
~preprocessor_deps ~lib_name ~scope =
let preprocessor_deps =
Build.memoize "preprocessor deps"
(Deps.interpret sctx ~scope ~dir preprocessor_deps)
in
let lint_module = lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope in
String_map.map modules ~f:(fun (m : Module.t) ->
match Preprocess_map.find m.name preprocess with
| No_preprocessing -> setup_reason_rules sctx ~dir m
| Action action ->
pped_module m ~dir ~f:(fun _kind src dst ->
add_rule sctx
(preprocessor_deps
>>>
Build.path src
>>^ (fun _ -> [src])
>>>
Action.run sctx
(Redirect
(Stdout,
target_var,
Chdir (root_var,
action)))
~dir
~dep_kind
~targets:(Static [dst])
~scope))
|> setup_reason_rules sctx ~dir
| Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
let m = setup_reason_rules sctx ~dir m in
pped_module m ~dir ~f:(fun kind src dst ->
add_rule sctx
(preprocessor_deps
>>>
Build.run ~context:sctx.context
(Ok ppx_exe)
[ As flags
; A "--dump-ast"
; As (cookie_library_name lib_name)
; A "-o"; Target dst
; Ml_kind.ppx_driver_flag kind; Dep src
])
)
match Preprocess_map.find m.name preprocess with
| No_preprocessing ->
let ast = setup_reason_rules sctx ~dir m in
lint_module ~ast ~source:m;
ast
| Action action ->
let ast =
pped_module m ~dir ~f:(fun _kind src dst ->
add_rule sctx
(preprocessor_deps
>>>
Build.path src
>>^ (fun _ -> [src])
>>>
Action.run sctx
(Redirect
(Stdout,
target_var,
Chdir (root_var,
action)))
~dir
~dep_kind
~targets:(Static [dst])
~scope))
|> setup_reason_rules sctx ~dir in
lint_module ~ast ~source:m;
ast
| Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
let ast = setup_reason_rules sctx ~dir m in
lint_module ~ast ~source:m;
pped_module ast ~dir ~f:(fun kind src dst ->
add_rule sctx
(preprocessor_deps
>>>
Build.run ~context:sctx.context
(Ok ppx_exe)
[ As flags
; A "--dump-ast"
; As (cookie_library_name lib_name)
; A "-o"; Target dst
; Ml_kind.ppx_driver_flag kind; Dep src
]))
)
end
let expand_and_eval_set t ~scope ~dir set ~standard =

6
src/super_context.mli
View File

@ -158,12 +158,14 @@ end
(** Preprocessing stuff *)
module PP : sig
(** Setup pre-processing rules and return the list of pre-processed modules *)
val pped_modules
(** Setup pre-processing and linting rules and return the list of
pre-processed modules *)
val pp_and_lint_modules
: t
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> modules:Module.t String_map.t
-> lint:Preprocess_map.t
-> preprocess:Preprocess_map.t
-> preprocessor_deps:Dep_conf.t list
-> lib_name:string option

1
src/utop.ml
View File

@ -49,6 +49,7 @@ let utop_of_libs (libs : Library.t list) =
(Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib ->
Lib_dep.direct lib.Library.name))
; preprocess = Preprocess_map.no_preprocessing
; lint = Lint.no_lint
; preprocessor_deps = []
; flags = Ordered_set_lang.Unexpanded.standard
; ocamlc_flags = Ordered_set_lang.Unexpanded.standard

7
test/blackbox-tests/test-cases/reason/jbuild
View File

@ -7,6 +7,10 @@
((name rlib)
(public_name rlib)
(modules (bar cppome foo hello pped))
(lint
(per_module
((pps (reasonppx (-lint true))) (hello cppome))
((action (run ./pp/reasononlypp.exe -lint ${<})) (foo bar pped))))
(preprocess
(per_module
((pps (reasonppx)) (foo))
@ -16,6 +20,7 @@
(executable
((name rbin)
(modules (rbin))
(lint (action (run ./pp/reasononlypp.exe -lint ${<})))
(preprocess (action (run ./pp/reasononlypp.exe ${<})))
(libraries (rlib))))
@ -28,4 +33,4 @@
(alias
((name runtest)
(deps (rbin.exe))
(action (run ${<}))))
(action (run ${<}))))

43
test/blackbox-tests/test-cases/reason/pp/reasononlypp.ml
View File

@ -1,15 +1,52 @@
let lint = ref false
let fname = ref None
let usage =
Printf.sprintf "%s [-lint] file" (Filename.basename Sys.executable_name)
let anon s =
match !fname with
| None -> fname := Some s
| Some _ -> raise (Arg.Bad "file must only be given once")
let is_ascii s =
try
for i=0 to String.length s - 1 do
if Char.code (s.[i]) > 127 then raise Exit
done;
true
with Exit ->
false
let () =
let fname = Sys.argv.(1) in
Arg.parse
["-lint", Arg.Set lint, "lint instead of preprocessing"
] anon usage;
let fname =
match !fname with
| None -> raise (Arg.Bad "file must be provided")
| Some f -> f in
if Filename.check_suffix fname ".re"
|| Filename.check_suffix fname ".rei" then (
if !lint && (Filename.check_suffix fname ".pp.re"
|| Filename.check_suffix fname ".pp.rei") then (
Format.eprintf "reason linter doesn't accept preprocessed file %s" fname;
);
let ch = open_in fname in
let rec loop () =
match input_line ch with
| exception End_of_file -> ()
| line -> print_endline line; loop () in
| line when is_ascii line ->
if not !lint then (
print_endline line
);
loop ()
| _ ->
Format.eprintf "%s isn't source code@.%!" fname;
exit 1
in
loop ();
close_in ch
close_in ch;
exit 0
) else (
Format.eprintf "%s is not a reason source@.%!" fname;
exit 1

2
test/blackbox-tests/test-cases/reason/rbin.re
View File

@ -3,4 +3,4 @@ open Rlib;
Cppome.run();
Hello.run();
Bar.run();
Foo.run();
Foo.run();