Merge pull request #613 from patricoferris/fix-attr-error-loop

Fix attr error loop

Author: patricoferris

CHANGES.md

@@ -1,6 +1,9 @@
 unreleased
 ----------
 
+- Fix infinite loop when duplicate attributes are present, raising
+  an error instead (#613, @ceastlund, @patricoferris)
+
 0.37.0
 ------
 

src/context_free.ml

@@ -366,7 +366,7 @@ let handle_attr_replace_once context attrs item base_ctxt : 'a option t =
           | [] -> return (false, Rule.Attr_replace.Parsed_payload_list.[])
           | x :: xs ->
               (if Attribute.Context.equal context (Attribute.context x) then
-                 Attribute.get_res x item |> of_result ~default:None
+                 return @@ Attribute.get x item
                else return None)
               >>= fun p ->
               get_attr_payloads xs >>| fun (any_attrs, ps) ->
@@ -377,10 +377,10 @@ let handle_attr_replace_once context attrs item base_ctxt : 'a option t =
         if any_attrs then
           Some
             ( (payloads, errors) >>= fun payloads ->
-              Attribute.remove_seen_res context
-                (Rule.Attr_replace.Attribute_list.to_packed_list a.attributes)
-                item
-              |> of_result ~default:item
+              return
+              @@ Attribute.remove_seen context
+                   (Rule.Attr_replace.Attribute_list.to_packed_list a.attributes)
+                   item
               >>| fun item -> a.expand ~ctxt:base_ctxt item payloads )
         else None)
   in

test/attr_replace/run.t

@@ -123,3 +123,33 @@ Test that the "attr_multiple_replace" infrastructure works.
   > EOF
   $ ./driver.exe test.ml
   let _ = ((prefix_foo_suffix)[@alert "-1"][@alert "-2"][@alert "-3"])
+
+Demonstrate error when multiple instances of one attribute are passed.
+  $ cat > test.ml << EOF
+  > let _ =
+  >   foo
+  >   [@prefix "prefix_"]
+  >   [@suffix "_suffix"]
+  >   [@suffix "_again"]
+  > EOF
+  $ ./driver.exe test.ml
+  File "test.ml", line 5, characters 4-10:
+  5 |   [@suffix "_again"]
+          ^^^^^^
+  Error: Duplicated attribute
+  [1]
+
+Demonstrate error when multiple instances of one attribute are passed and
+no other attributes are available.
+  $ cat > test.ml << EOF
+  > let _ =
+  >   foo
+  >   [@suffix "_suffix"]
+  >   [@suffix "_again"]
+  > EOF
+  $ ./driver.exe test.ml
+  File "test.ml", line 4, characters 4-10:
+  4 |   [@suffix "_again"]
+          ^^^^^^
+  Error: Duplicated attribute
+  [1]