Release coccinelle-0.2.4

[bpt/coccinelle.git] / parsing_cocci / free_vars.ml

diff --git a/parsing_cocci/free_vars.ml b/parsing_cocci/free_vars.ml
index 3efc01e..c5eab34 100644 (file)
--- a/parsing_cocci/free_vars.ml
+++ b/parsing_cocci/free_vars.ml
@@ -22,6 +22,30 @@
  *)
 
 
+(*
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
 (* For each rule return the list of variables that are used after it.
 Also augment various parts of each rule with unitary, inherited, and freshness
 informations *)
@@ -103,6 +127,10 @@ let collect_refs include_constraints =
   let rec type_collect res = function
       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
     | TC.Array(ty) -> type_collect res ty
+    | TC.EnumName(TC.MV(tyname,_,_)) ->
+       bind [tyname] res
+    | TC.StructUnionName(_,TC.MV(tyname,_,_)) ->
+       bind [tyname] res
     | TC.MetaType(tyname,_,_) ->
        bind [tyname] res
     | TC.SignedT(_,Some ty) -> type_collect res ty
@@ -131,16 +159,17 @@ let collect_refs include_constraints =
              | _ -> []
            else [] in
          bind extra [metaid name]
-      | Ast.MetaExprList(name,None,_,_) -> [metaid name]
-      | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
+      | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) ->
          [metaid name;metaid lenname]
+      | Ast.MetaExprList(name,_,_,_) -> [metaid name]
       | Ast.DisjExpr(exps) -> bind_disj (List.map k exps)
       | _ -> option_default) in
 
   let astfvdecls recursor k d =
     bind (k d)
       (match Ast.unwrap d with
-       Ast.DisjDecl(decls) -> bind_disj (List.map k decls)
+       Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> [metaid name]
+      | Ast.DisjDecl(decls) -> bind_disj (List.map k decls)
       | _ -> option_default) in
 
   let astfvfullType recursor k ty =
@@ -165,9 +194,9 @@ let collect_refs include_constraints =
     bind (k p)
       (match Ast.unwrap p with
        Ast.MetaParam(name,_,_) -> [metaid name]
-      | Ast.MetaParamList(name,None,_,_) -> [metaid name]
-      | Ast.MetaParamList(name,Some(lenname,_,_),_,_) ->
+      | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
          [metaid name;metaid lenname]
+      | Ast.MetaParamList(name,_,_,_) -> [metaid name]
       | _ -> option_default) in
 
   let astfvrule_elem recursor k re =
@@ -196,7 +225,7 @@ let collect_refs include_constraints =
 
   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
     astfvident astfvexpr astfvfullType astfvtypeC astfvinit astfvparam
     astfvdecls astfvrule_elem astfvstatement donothing donothing donothing_a
 
@@ -232,6 +261,10 @@ let collect_saved =
   let rec type_collect res = function
       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
     | TC.Array(ty) -> type_collect res ty
+    | TC.EnumName(TC.MV(tyname,TC.Saved,_)) ->
+       bind [tyname] res
+    | TC.StructUnionName(_,TC.MV(tyname,TC.Saved,_)) ->
+       bind [tyname] res
     | TC.MetaType(tyname,TC.Saved,_) ->
        bind [tyname] res
     | TC.SignedT(_,Some ty) -> type_collect res ty
@@ -247,13 +280,14 @@ let collect_saved =
       bind (k e)
        (match Ast.unwrap e with
          Ast.MetaErr(name,_,TC.Saved,_) | Ast.MetaExpr(name,_,TC.Saved,_,_,_)
-       | Ast.MetaExprList(name,None,TC.Saved,_) -> [metaid name]
-       | Ast.MetaExprList(name,Some (lenname,ls,_),ns,_) ->
+         -> [metaid name]
+       | Ast.MetaExprList(name,Ast.MetaListLen (lenname,ls,_),ns,_) ->
            let namesaved =
              match ns with TC.Saved -> [metaid name] | _ -> [] in
            let lensaved =
              match ls with TC.Saved -> [metaid lenname] | _ -> [] in
            lensaved @ namesaved
+       | Ast.MetaExprList(name,_,TC.Saved,_) -> [metaid name]
        | _ -> option_default) in
     bind tymetas vars in
 
@@ -272,14 +306,21 @@ let collect_saved =
   let astfvparam recursor k p =
     bind (k p)
       (match Ast.unwrap p with
-       Ast.MetaParam(name,TC.Saved,_)
-      | Ast.MetaParamList(name,None,_,_) -> [metaid name]
-      | Ast.MetaParamList(name,Some (lenname,ls,_),ns,_) ->
+       Ast.MetaParam(name,TC.Saved,_) -> [metaid name]
+      | Ast.MetaParamList(name,Ast.MetaListLen (lenname,ls,_),ns,_) ->
          let namesaved =
            match ns with TC.Saved -> [metaid name] | _ -> [] in
          let lensaved =
            match ls with TC.Saved -> [metaid lenname] | _ -> [] in
          lensaved @ namesaved
+      | Ast.MetaParamList(name,_,_,_) -> [metaid name]
+      | _ -> option_default) in
+
+  let astfvdecls recursor k d =
+    bind (k d)
+      (match Ast.unwrap d with
+       Ast.MetaDecl(name,TC.Saved,_) | Ast.MetaField(name,TC.Saved,_) ->
+         [metaid name]
       | _ -> option_default) in
 
   let astfvrule_elem recursor k re =
@@ -298,9 +339,9 @@ let collect_saved =
 
   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
     astfvident astfvexpr donothing astfvtypeC astfvinit astfvparam
-    donothing astfvrule_elem donothing donothing donothing donothing
+    astfvdecls astfvrule_elem donothing donothing donothing donothing
 
 (* ---------------------------------------------------------------- *)
 
@@ -411,7 +452,7 @@ let collect_in_plus_term =
 
   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 astfvrule_elem astfvstatement donothing donothing donothing
 
@@ -482,6 +523,12 @@ let classify_variables metavar_decls minirules used_after =
     | TC.Pointer(ty) -> TC.Pointer(type_infos ty)
     | TC.FunctionPointer(ty) -> TC.FunctionPointer(type_infos ty)
     | TC.Array(ty) -> TC.Array(type_infos ty)
+    | TC.EnumName(TC.MV(name,_,_)) ->
+       let (unitary,inherited) = classify (name,(),(),Ast.NoMetaPos) in
+       TC.EnumName(TC.MV(name,unitary,inherited))
+    | TC.StructUnionName(su,TC.MV(name,_,_)) ->
+       let (unitary,inherited) = classify (name,(),(),Ast.NoMetaPos) in
+       TC.StructUnionName(su,TC.MV(name,unitary,inherited))
     | TC.MetaType(name,_,_) ->
        let (unitary,inherited) = classify (name,(),(),Ast.NoMetaPos) in
        Type_cocci.MetaType(name,unitary,inherited)
@@ -498,19 +545,21 @@ let classify_variables metavar_decls minirules used_after =
        let (unitary,inherited) = classify name in
        let ty = get_option (List.map type_infos) ty in
        Ast.rewrap e (Ast.MetaExpr(name,constraints,unitary,ty,form,inherited))
-    | Ast.MetaExprList(name,None,_,_) ->
-       (* lenname should have the same properties of being unitary or
-          inherited as name *)
-       let (unitary,inherited) = classify name in
-       Ast.rewrap e (Ast.MetaExprList(name,None,unitary,inherited))
-    | Ast.MetaExprList(name,Some(lenname,_,_),_,_) ->
+    | Ast.MetaExprList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
        (* lenname should have the same properties of being unitary or
           inherited as name *)
        let (unitary,inherited) = classify name in
        let (lenunitary,leninherited) = classify lenname in
        Ast.rewrap e
          (Ast.MetaExprList
-            (name,Some(lenname,lenunitary,leninherited),unitary,inherited))
+            (name,
+             Ast.MetaListLen(lenname,lenunitary,leninherited),
+             unitary,inherited))
+    | Ast.MetaExprList(name,lenname,_,_) ->
+       (* lenname should have the same properties of being unitary or
+          inherited as name *)
+       let (unitary,inherited) = classify name in
+       Ast.rewrap e (Ast.MetaExprList(name,lenname,unitary,inherited))
     | _ -> e in
 
   let typeC r k e =
@@ -535,15 +584,27 @@ let classify_variables metavar_decls minirules used_after =
       Ast.MetaParam(name,_,_) ->
        let (unitary,inherited) = classify name in
        Ast.rewrap e (Ast.MetaParam(name,unitary,inherited))
-    | Ast.MetaParamList(name,None,_,_) ->
-       let (unitary,inherited) = classify name in
-       Ast.rewrap e (Ast.MetaParamList(name,None,unitary,inherited))
-    | Ast.MetaParamList(name,Some (lenname,_,_),_,_) ->
+    | Ast.MetaParamList(name,Ast.MetaListLen (lenname,_,_),_,_) ->
        let (unitary,inherited) = classify name in
        let (lenunitary,leninherited) = classify lenname in
        Ast.rewrap e
          (Ast.MetaParamList
-            (name,Some (lenname,lenunitary,leninherited),unitary,inherited))
+            (name,Ast.MetaListLen(lenname,lenunitary,leninherited),
+             unitary,inherited))
+    | Ast.MetaParamList(name,lenname,_,_) ->
+       let (unitary,inherited) = classify name in
+       Ast.rewrap e (Ast.MetaParamList(name,lenname,unitary,inherited))
+    | _ -> e in
+
+  let decl r k e =
+    let e = k e in
+    match Ast.unwrap e with
+      Ast.MetaDecl(name,_,_) ->
+       let (unitary,inherited) = classify name in
+       Ast.rewrap e (Ast.MetaDecl(name,unitary,inherited))
+    | Ast.MetaField(name,_,_) ->
+       let (unitary,inherited) = classify name in
+       Ast.rewrap e (Ast.MetaField(name,unitary,inherited))
     | _ -> e in
 
   let rule_elem r k e =
@@ -559,8 +620,8 @@ let classify_variables metavar_decls minirules used_after =
 
   let fn = V.rebuilder
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-      donothing donothing donothing donothing
-      ident expression donothing typeC init param donothing rule_elem
+      donothing donothing donothing donothing donothing
+      ident expression donothing typeC init param decl rule_elem
       donothing donothing donothing donothing in
 
   List.map fn.V.rebuilder_top_level minirules
@@ -691,7 +752,7 @@ let astfvs metavars bound =
 
   V.rebuilder
     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-    donothing donothing astfvstatement_dots donothing
+    donothing donothing astfvstatement_dots donothing donothing
     donothing donothing donothing donothing donothing donothing donothing
     astfvrule_elem astfvstatement astfvcase_line astfvtoplevel donothing
 
@@ -713,7 +774,10 @@ let collect_astfvs rules =
       [] -> []
     | (metavars, rule)::rules ->
         match rule with
-          Ast.ScriptRule (_,_,_,_,_)
+          Ast.ScriptRule (_,_,_,_,script_vars,_) ->
+           (* why are metavars in rule, but outside for cocci rule??? *)
+            let bound = script_vars @ bound in
+           rule::(loop bound rules)
        | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) ->
            (* bound stays as is because script rules have no names, so no
               inheritance is possible *)
@@ -750,7 +814,7 @@ let get_neg_pos_list (_,rule) used_after_list =
   let v =
     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 donothing donothing donothing donothing in
   match rule with
@@ -785,13 +849,16 @@ let collect_top_level_used_after metavar_rule_list =
     List.fold_right
       (function (metavar_list,r) ->
        function (used_after,used_after_lists) ->
-         let locally_defined = List.map Ast.get_meta_name metavar_list in
+         let locally_defined =
+            match r with
+              Ast.ScriptRule (_,_,_,_,free_vars,_) -> free_vars
+           | _ -> List.map Ast.get_meta_name metavar_list in
          let continue_propagation =
            List.filter (function x -> not(List.mem x locally_defined))
              used_after in
          let free_vars =
             match r with
-              Ast.ScriptRule (_,_,_,mv,_) ->
+              Ast.ScriptRule (_,_,_,mv,_,_) ->
                 drop_virt(List.map (function (_,(r,v),_) -> (r,v)) mv)
             | Ast.InitialScriptRule (_,_,_,_)
            | Ast.FinalScriptRule (_,_,_,_) -> []
@@ -901,9 +968,9 @@ let collect_used_after metavar_rule_list =
     (function (metavars,r) ->
       function used_after ->
         match r with
-          Ast.ScriptRule (_,_,_,_,_)
+          Ast.ScriptRule (_,_,_,_,_,_) (* no minirules, so nothing to do? *)
        | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) ->
-           ([], [used_after], [], [])
+           ([], [used_after], [[]], [])
         | Ast.CocciRule (name, rule_info, minirules, _,_) ->
           collect_local_used_after metavars minirules used_after
     )
@@ -927,7 +994,7 @@ let free_vars rules =
     List.map
       (function (mv, r) ->
          match r with
-           Ast.ScriptRule _
+           Ast.ScriptRule _ (* doesn't declare position variables *)
         | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> []
          | Ast.CocciRule (_,_,rule,_,_) ->
            let positions =