Fix #1372

CHANGES.md

@@ -12,6 +12,9 @@ next
 
 - Pass `--set-switch` to opam (#1341, fix #1337, @diml)
 
+- Fix bad interaction between multi-directory libraries the `menhir`
+  stanza (#1373, fix #1372, @diml)
+
 1.3.0 (23/09/2018)
 ------------------
 

src/gen_rules.ml

@@ -215,7 +215,7 @@ module Gen(P : Install_rules.Params) = struct
      | Stanza                                                          |
      +-----------------------------------------------------------------+ *)
 
-  let gen_rules dir_contents
+  let gen_rules dir_contents cctxs
         { SC.Dir_with_dune. src_dir; ctx_dir; stanzas; scope; kind } =
     let merlins, cctxs =
       let rec loop stanzas merlins cctxs =
@@ -260,7 +260,7 @@ module Gen(P : Install_rules.Params) = struct
           | _ ->
             loop stanzas merlins cctxs
       in
-      loop stanzas [] []
+      loop stanzas [] cctxs
     in
     Option.iter (Merlin.merge_all merlins) ~f:(fun m ->
       let more_src_dirs =
@@ -298,14 +298,15 @@ module Gen(P : Install_rules.Params) = struct
                       produced by this stanza are part of."
                })
         | Some cctx ->
-          Menhir_rules.gen_rules cctx m
+          Menhir_rules.gen_rules cctx m ~dir:ctx_dir
         end
-      | _ -> ())
+      | _ -> ());
+    cctxs
 
-  let gen_rules dir_contents ~dir =
+  let gen_rules dir_contents cctxs ~dir : (Loc.t * Compilation_context.t) list =
     match SC.stanzas_in sctx ~dir with
-    | None -> ()
-    | Some d -> gen_rules dir_contents d
+    | None -> []
+    | Some d -> gen_rules dir_contents cctxs d
 
   let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep =
     (match components with
@@ -327,13 +328,14 @@ module Gen(P : Install_rules.Params) = struct
          let dir_contents = Dir_contents.get sctx ~dir in
          match Dir_contents.kind dir_contents with
          | Standalone ->
-           gen_rules dir_contents ~dir
+           ignore (gen_rules dir_contents [] ~dir : _ list)
          | Group_part root ->
            SC.load_dir sctx ~dir:(Dir_contents.dir root)
          | Group_root (lazy subs) ->
-           gen_rules dir_contents ~dir;
+           let cctxs = gen_rules dir_contents [] ~dir in
            List.iter subs ~f:(fun dc ->
-             gen_rules dir_contents ~dir:(Dir_contents.dir dc)));
+             ignore (gen_rules dir_contents cctxs ~dir:(Dir_contents.dir dc)
+                     : _ list)));
     match components with
     | [] -> These (String.Set.of_list [".js"; "_doc"; ".ppx"])
     | [(".js"|"_doc"|".ppx")] -> All

src/menhir.ml

@@ -148,10 +148,10 @@ let module_names (stanza : Dune_file.Menhir.t) =
   | Some m -> [Module.Name.of_string m]
   | None -> List.map stanza.modules ~f:Module.Name.of_string
 
-let gen_rules cctx stanza =
+let gen_rules cctx stanza ~dir =
   let module R = Run(struct
     let sctx = Compilation_context.super_context cctx
-    let dir = Compilation_context.dir cctx
+    let dir = dir
     let scope = Compilation_context.scope cctx
     let stanza = stanza
   end) in

src/menhir.mli

@@ -1,5 +1,7 @@
 (** Menhir rules *)
 
+open Stdune
+
 (** Return the list of targets that are generated by this stanza. This
     list of targets is used by the code that computes the list of
     modules in the directory. *)
@@ -12,4 +14,5 @@ val module_names : Dune_file.Menhir.t -> Module.Name.t list
 val gen_rules
   :  Compilation_context.t
   -> Dune_file.Menhir.t
+  -> dir:Path.t
   -> unit

test/blackbox-tests/dune.inc

@@ -287,6 +287,14 @@
    test-cases/github1342
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name github1372)
+ (deps (package dune) (source_tree test-cases/github1372))
+ (action
+  (chdir
+   test-cases/github1372
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name github20)
  (deps (package dune) (source_tree test-cases/github20))
@@ -986,6 +994,7 @@
   (alias github1099)
   (alias github1231)
   (alias github1342)
+  (alias github1372)
   (alias github20)
   (alias github24)
   (alias github25)
@@ -1102,6 +1111,7 @@
   (alias github1099)
   (alias github1231)
   (alias github1342)
+  (alias github1372)
   (alias github20)
   (alias github24)
   (alias github25)

test/blackbox-tests/test-cases/github1372/dir/dune

@@ -0,0 +1 @@
+(menhir (modules parser))

test/blackbox-tests/test-cases/github1372/dir/parser.mly

@@ -0,0 +1,9 @@
+%start <char list> main
+%token <char> TOKEN
+%token EOF
+
+%%
+
+main:
+| c = TOKEN EOF { [c] }
+| c = TOKEN xs = main  { c :: xs }

test/blackbox-tests/test-cases/github1372/dune

@@ -0,0 +1,3 @@
+(include_subdirs unqualified)
+
+(library (name foo))

test/blackbox-tests/test-cases/github1372/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.3)
+(using menhir 1.0)

test/blackbox-tests/test-cases/github1372/run.t

@@ -0,0 +1,3 @@
+Reproduction case for #1372
+
+  $ dune build foo.cma