Merge pull request #2208 from rgrinberg/fix-merlin-with-equal-pp

Fix generation of melrin with equal ppx pp

CHANGES.md

@@ -84,6 +84,9 @@ unreleased
   would be undetected whenever the project was nested in another workspace.
   (#2194, @rgrinberg)
 
+- Fix generation of `.merlin` whenever there's more than one stanza with the
+  same ppx preprocessing specification (#2209 ,fixes #2206, @rgrinberg)
+
 1.9.3 (06/05/2019)
 ------------------
 

src/dune_file.ml

@@ -291,16 +291,32 @@ module Dep_conf = struct
 end
 
 module Preprocess = struct
-  type pps =
-    { loc : Loc.t
-    ; pps : (Loc.t * Lib_name.t) list
-    ; flags : String_with_vars.t list
-    ; staged : bool
-    }
+  module Pps = struct
+    type t =
+      { loc : Loc.t
+      ; pps : (Loc.t * Lib_name.t) list
+      ; flags : String_with_vars.t list
+      ; staged : bool
+      }
+
+    let compare_no_locs { loc = _ ; pps = pps1; flags = flags1; staged = s1 }
+          { loc = _; pps = pps2; flags = flags2; staged = s2 } =
+      match Bool.compare s1 s2 with
+      | Lt | Gt as t -> t
+      | Eq ->
+        match
+          List.compare flags1 flags2 ~compare:String_with_vars.compare_no_loc
+        with
+        | Lt | Gt as t -> t
+        | Eq ->
+          List.compare pps1 pps2 ~compare:(fun (_, x) (_, y) ->
+            Lib_name.compare x y)
+  end
+
   type t =
     | No_preprocessing
     | Action of Loc.t * Action_dune_lang.t
-    | Pps    of pps
+    | Pps    of Pps.t
     | Future_syntax of Loc.t
 
   let decode =
@@ -339,7 +355,7 @@ module Preprocess = struct
     type t =
       | No_preprocessing
       | Action of Loc.t * Action_dune_lang.t
-      | Pps    of pps
+      | Pps    of Pps.t
   end
 
   let remove_future_syntax t v : Without_future_syntax.t =

src/dune_file.mli

@@ -4,24 +4,28 @@ open! Stdune
 open Import
 
 module Preprocess : sig
-  type pps =
-    { loc   : Loc.t
-    ; pps   : (Loc.t * Lib_name.t) list
-    ; flags : String_with_vars.t list
-    ; staged : bool
-    }
+  module Pps : sig
+    type t =
+      { loc   : Loc.t
+      ; pps   : (Loc.t * Lib_name.t) list
+      ; flags : String_with_vars.t list
+      ; staged : bool
+      }
+
+    val compare_no_locs : t -> t -> Ordering.t
+  end
 
   type t =
     | No_preprocessing
     | Action of Loc.t * Action_dune_lang.t
-    | Pps    of pps
+    | Pps    of Pps.t
     | Future_syntax of Loc.t
 
   module Without_future_syntax : sig
     type t =
       | No_preprocessing
       | Action of Loc.t * Action_dune_lang.t
-      | Pps    of pps
+      | Pps    of Pps.t
   end
 
   val loc : t -> Loc.t option

src/merlin.ml

@@ -42,16 +42,15 @@ module Preprocess = struct
       warn_dropped_pp loc ~allow_approx_merlin
         ~reason:"cannot mix action and pps preprocessors";
       No_preprocessing
-    | Pps { loc ; pps = pps1; flags = flags1; staged = s1 },
-      Pps { loc = _; pps = pps2; flags = flags2; staged = s2 } ->
-      if Bool.(<>) s1 s2
-      || List.compare flags1 flags2 ~compare:String_with_vars.compare_no_loc <> Eq
-      || List.compare pps1 pps2 ~compare:(fun (_, x) (_, y) ->
-        Lib_name.compare x y) <> Eq
-      then
-        warn_dropped_pp loc ~allow_approx_merlin
+    | Pps pp1 as pp, Pps pp2 ->
+      if Ordering.neq (Dune_file.Preprocess.Pps.compare_no_locs pp1 pp2)
+      then begin
+        warn_dropped_pp pp1.loc ~allow_approx_merlin
           ~reason:"pps specification isn't identical in all stanzas";
-      No_preprocessing
+        No_preprocessing
+      end
+      else
+        pp
 end
 
 let quote_for_merlin s =
@@ -188,7 +187,8 @@ let pp_flags sctx ~expander ~dir_kind { preprocess; libname; _ }
     match Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname
             ~flags ~scope ~dir_kind pps
     with
-    | Error _ -> Build.return None
+    | Error _exn ->
+      Build.return None
     | Ok (exe, flags) ->
       (Path.to_absolute_filename (Path.build exe)
        :: "--as-ppx" :: flags)

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

@@ -34,12 +34,12 @@
   S $LIB_PREFIX/lib/ocaml
   S .
   S subdir
+  FLG -ppx '$PPX/fcfe04ecb8bb41c1143a3b9acec18678/ppx.exe --as-ppx --cookie '\''library-name="foo"'\'''
   FLG -open Foo -w -40 -open Bar -w -40
 
 Make sure a ppx directive is generated
 
   $ grep -q ppx lib/.merlin
-  [1]
 
 Make sure pp flag is correct and variables are expanded