diff --git a/src/dune_rules/package.ml b/src/dune_rules/package.ml index 93aa1fb82999..82f7bba7f4fa 100644 --- a/src/dune_rules/package.ml +++ b/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 diff --git a/test/blackbox-tests/test-cases/github3431.t b/test/blackbox-tests/test-cases/github3431.t index 5bc8ac8334b1..c26ebba27eb4 100644 --- a/test/blackbox-tests/test-cases/github3431.t +++ b/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"})