coccinelle release 0.2.5

[bpt/coccinelle.git] / engine / asttoctl2.ml

diff --git a/engine/asttoctl2.ml b/engine/asttoctl2.ml
index 5b7cd6f..b5f8364 100644 (file)
--- a/engine/asttoctl2.ml
+++ b/engine/asttoctl2.ml
@@ -78,7 +78,8 @@ let ctl_or_fl x y     =
 
 let ctl_seqor x y     =
   match (x,y) with
-    (CTL.True,_) | (_,CTL.True) -> CTL.True
+    (* drop x or true case because x might have side effects *)
+    (CTL.True,_) (* | (_,CTL.True) *) -> CTL.True
   | (CTL.False,a) | (a,CTL.False) -> a
   | _ -> CTL.SeqOr(x,y)
 
@@ -349,7 +350,7 @@ let elim_opt =
 
   V.rebuilder
     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-    donothing donothing stmtdotsfn donothing
+    donothing donothing stmtdotsfn donothing donothing
     donothing donothing donothing donothing donothing donothing donothing
     donothing donothing donothing donothing donothing
 
@@ -450,12 +451,12 @@ let contains_modif =
   let init r k i =
     let res = k i in
     match Ast.unwrap i with
-      Ast.InitList(allminus,_,_,_,_) -> allminus or res
+      Ast.StrInitList(allminus,_,_,_,_) -> allminus or res
     | _ -> res in
   let recursor =
     V.combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-      do_nothing do_nothing do_nothing do_nothing
+      do_nothing do_nothing do_nothing do_nothing do_nothing
       do_nothing do_nothing do_nothing do_nothing init do_nothing
       do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in
   recursor.V.combiner_rule_elem
@@ -478,7 +479,7 @@ let contains_pos =
   let recursor =
     V.combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-      do_nothing do_nothing do_nothing do_nothing
+      do_nothing do_nothing do_nothing do_nothing do_nothing
       do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
       do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in
   recursor.V.combiner_rule_elem
@@ -498,7 +499,12 @@ let make_match label guard code =
     | _ -> CTL.Exists(true,v,predmaker guard (matcher,CTL.UnModif v) label))
 
 let make_raw_match label guard code =
-  predmaker guard (Lib_engine.Match(code),CTL.Control) label
+  match intersect !used_after (Ast.get_fvs code) with
+    [] -> predmaker guard (Lib_engine.Match(code),CTL.Control) label
+  | _ ->
+      let v = fresh_var() in
+    CTL.Exists(true,v,predmaker guard (Lib_engine.Match(code),CTL.UnModif v)
+                label)
 
 let rec seq_fvs quantified = function
     [] -> []
@@ -544,7 +550,7 @@ let count_nested_braces s =
   let mcode r x = 0 in
   let recursor = V.combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-      donothing donothing donothing donothing
+      donothing donothing donothing donothing donothing
       donothing donothing donothing donothing donothing donothing
       donothing donothing stmt_count donothing donothing donothing in
   let res = string_of_int (recursor.V.combiner_statement s) in
@@ -1786,17 +1792,14 @@ and statement stmt after quantified minus_quantified
       let (lbfvs,b1fvs,b2fvs,rbfvs) =
        match
          seq_fvs quantified
-           [Ast.get_fvs lbrace;
-             Ast.get_fvs body;Ast.get_fvs rbrace]
+           [Ast.get_fvs lbrace;Ast.get_fvs body;Ast.get_fvs rbrace]
        with
-         [(lbfvs,b1fvs);(_,b2fvs);(rbfvs,_)] ->
-           (lbfvs,b1fvs,b2fvs,rbfvs)
+         [(lbfvs,b1fvs);(_,b2fvs);(rbfvs,_)] -> (lbfvs,b1fvs,b2fvs,rbfvs)
        | _ -> failwith "not possible" in
       let (mlbfvs,mb1fvs,mb2fvs,mrbfvs) =
        match
          seq_fvs minus_quantified
-           [Ast.get_mfvs lbrace;
-             Ast.get_mfvs body;Ast.get_mfvs rbrace]
+           [Ast.get_mfvs lbrace;Ast.get_mfvs body;Ast.get_mfvs rbrace]
        with
          [(lbfvs,b1fvs);(_,b2fvs);(rbfvs,_)] ->
            (lbfvs,b1fvs,b2fvs,rbfvs)
@@ -1818,9 +1821,7 @@ and statement stmt after quantified minus_quantified
        (* label is not needed; paren_pred is enough *)
        quantify guard rbfvs
          (ctl_au (make_match empty_rbrace)
-            (ctl_and
-               (real_make_match None guard rbrace)
-               paren_pred)) in
+            (ctl_and (real_make_match None guard rbrace) paren_pred)) in
       let new_quantified2 =
        Common.union_set b1fvs (Common.union_set b2fvs quantified) in
       let new_mquantified2 =
@@ -1839,7 +1840,23 @@ and statement stmt after quantified minus_quantified
                           new_quantified2 new_mquantified2
                           (Some (lv,ref true))
                           llabel slabel false guard)))])) in
-      if ends_in_return body
+      let empty_body =
+       match Ast.undots body with
+         [body] ->
+           (match Ast.unwrap body with
+             Ast.Dots
+               ((_,i,Ast.CONTEXT(_,Ast.NOTHING),_),[],_,_) ->
+                 (match Ast.unwrap rbrace with
+                   Ast.SeqEnd((_,_,Ast.CONTEXT(_,Ast.NOTHING),_))
+                   when not (contains_pos rbrace) -> true
+                 | _ -> false)
+           | _ -> false)
+       | _ -> false in
+      if empty_body && after = Tail
+         (* for just a match of an if branch of the form { ... }, just
+            match the first brace *)
+      then quantify guard lbfvs (make_match lbrace)
+      else if ends_in_return body
       then
        (* matching error handling code *)
        (* Cases:
@@ -1908,7 +1925,8 @@ and statement stmt after quantified minus_quantified
 
   | Ast.Nest(starter,stmt_dots,ender,whencode,multi,bef,aft) ->
       (* label in recursive call is None because label check is already
-        wrapped around the corresponding code *)
+        wrapped around the corresponding code. not good enough, want to stay
+        in a specific region, dots and nests will keep going *)
 
       let bfvs =
        match seq_fvs quantified [Ast.get_wcfvs whencode;Ast.get_fvs stmt_dots]
@@ -1930,16 +1948,16 @@ and statement stmt after quantified minus_quantified
       quantify guard bfvs
        (let dots_pattern =
          statement_list stmt_dots (a2n after) new_quantified minus_quantified
-           None llabel slabel true guard in
+           label(*None*) llabel slabel true guard in
        dots_and_nests multi
          (Some dots_pattern) whencode bef aft dot_code after label
          (process_bef_aft new_quantified minus_quantified
-            None llabel slabel true)
+            label(*None*) llabel slabel true)
          (function x ->
-           statement_list x Tail new_quantified minus_quantified None
+           statement_list x Tail new_quantified minus_quantified label(*None*)
              llabel slabel true true)
          (function x ->
-           statement x Tail new_quantified minus_quantified None
+           statement x Tail new_quantified minus_quantified label(*None*)
              llabel slabel true)
          guard quantified
          (function x -> Ast.set_fvs [] (Ast.rewrap stmt x)))