fix ocaml#3431 with brute force

Signed-off-by: Lucccyo <cha.git@mailo.fr>

src/dune_rules/package.ml

@@ -252,8 +252,89 @@ module Dependency = struct
       nopos (Logop (nopos `Or, opam_constraint c, opam_constraint (And cs)))
     | And [] | Or [] -> Code_error.raise "opam_constraint" []
 
+
+
+    open OpamParserTypes.FullPos
+
+    let with_pos v = { pelem = v; pos = { filename = ""; start = 0,0; stop = 0,0 } }
+
+    (** [decide context p value] returns [true] whenever [value]
+        should be parenthesized inside [context] at position [p]
+        ([false] means left-hand side, [true] means right-hand side).
+    *)
+    let decide context p value= match context, value with
+    (* [ atom (prefix_relop atom) ] *)
+    | (List _ | Group _), Prefix_relop _ -> true
+    | Option _, Prefix_relop _ when p -> true
+    (* otherwise, juxtaposition inside lists is unambiguous *)
+    | (List _ | Group _), _ -> false
+    | Option _, _ when p -> false
+    (* atoms cannot have subtrees *)
+    | (Bool _ | Int _ | String _ | Ident _), _ -> assert false
+    (* atoms and bracketed values should never be parenthesized *)
+    | _, (Bool _ | Int _ | String _ | Ident _ | List _ | Group _) -> false
+    (* [or] and [and] are left-associative, so we check [p] *)
+    | Logop ({ pelem = `Or ; _ }, _, _), Logop ({ pelem = `Or ; _ }, _, _) -> p
+    | Logop ({ pelem = `And ; _ }, _, _), Logop ({ pelem = `And ; _ }, _, _) -> p
+    (* [or] is the weakest binary operator, no need to parenthize its children *)
+    | Logop ({ pelem = `Or ; _ }, _, _), _ -> false
+    (* [or] contained in anything else should be parenthesized *)
+    | _, Logop ({ pelem = `Or ; _ }, _, _) -> true
+    (* [and] in the next weakest, no need to parenthesize its children *)
+    | Logop ({ pelem = `And ; _ }, _, _), _ -> false
+    (* [and] contained in anything else should be parenthesized *)
+    | _, Logop ({ pelem = `And ; _ }, _, _) -> true
+    (* [prefix_op] is the next weakest, no need to parenthesize its child *)
+    | Pfxop _, _ -> false
+    (* [prefix_op] contained in anything else should be parenthesized *)
+    | _, Pfxop _ -> true
+    (* [option] (left-hand side) in the next weakest *)
+    | Option _, _ -> false
+    (* [option], etc. contained in anything else is a parsing error,
+      so we parenthesize to make the alternative parsings impossible *)
+    | _, (Option _ | Relop _ | Prefix_relop _ | Env_binding _) -> true
+
+  let rec add_group context p value =
+    let v = match value.pelem with
+      | Bool _ | Int _ | String _ | Ident _ -> value
+      | Relop (op, lvk, rvk) -> with_pos @@
+          Relop (op, add_group value false lvk,
+                    add_group value true  rvk)
+      | Prefix_relop (op, lvk) -> with_pos @@
+          Prefix_relop (op, add_group value false lvk)
+      | Logop (op, lvk, rvk) -> with_pos @@
+          Logop (op, add_group value false lvk,
+                    add_group value true  rvk)
+      | Pfxop (op, lvk) -> with_pos @@
+          Pfxop (op, add_group value false lvk)
+      | Env_binding (lvk, op, rvk) -> with_pos @@
+          Env_binding (add_group value false lvk, op,
+                      add_group value true  rvk)
+      | List l -> with_pos @@
+          List (with_pos @@ List.map ~f:(add_group value false) l.pelem)
+      | Group l -> with_pos @@
+          Group (with_pos @@ List.map ~f:(add_group value false) l.pelem)
+      | Option (lvk, l) -> with_pos @@
+          Option (add_group value false lvk,
+                  with_pos @@ List.map ~f:(add_group value true) l.pelem)
+    in
+    if decide context.pelem p v.pelem
+      then with_pos (Group (with_pos [v]))
+      else v
+
+  let add_group value =
+    let bidon = with_pos (Group (with_pos [])) in
+    add_group bidon false value
+
+
+
+  let super_opam_constraint t =
+    add_group (opam_constraint t)
+
+
+
   let opam_depend { name; constraint_ } =
-    let constraint_ = Option.map ~f:opam_constraint constraint_ in
+    let constraint_ = Option.map ~f:super_opam_constraint constraint_ in
     let pkg = nopos (OpamParserTypes.FullPos.String (Name.to_string name)) in
     match constraint_ with
     | None -> pkg

test/blackbox-tests/test-cases/github3431.t

@@ -21,6 +21,6 @@ See #3431.
   $ dune build
 
   $ grep '"a"' p.opam
-    "a" {with-test | dev & >= "1.1.0"}
+    "a" {(with-test | dev) & >= "1.1.0"}
 
 (the correct line is: "a" {(with-test | dev) & >= "1.1.0"})