Coccinelle release 1.0.0-rc3
[bpt/coccinelle.git] / engine / cocci_vs_c.ml
index 3ac63b5..a5e297c 100644 (file)
@@ -1,3 +1,27 @@
+(*
+ * 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.
+ *)
+
+
 open Common
 
 module A = Ast_cocci
@@ -81,12 +105,12 @@ let mcodekind mc = A.get_mcodekind mc
 let mcode_contain_plus = function
   | A.CONTEXT (_,A.NOTHING) -> false
   | A.CONTEXT _ -> true
-  | A.MINUS (_,_,_,[]) -> false
-  | A.MINUS (_,_,_,x::xs) -> true
+  | A.MINUS (_,_,_,A.NOREPLACEMENT) -> false
+  | A.MINUS (_,_,_,A.REPLACEMENT _) -> true (* repl is nonempty *)
   | A.PLUS _ -> raise Impossible
 
 let mcode_simple_minus = function
-  | A.MINUS (_,_,_,[]) -> true
+  | A.MINUS (_,_,_,A.NOREPLACEMENT) -> true
   | _ -> false
 
 
@@ -101,8 +125,8 @@ let mcode_simple_minus = function
 let minusizer =
   ("fake","fake"),
   {A.line = 0; A.column =0; A.strbef=[]; A.straft=[];},
-  (A.MINUS(A.DontCarePos,[],-1,[])),
-  A.NoMetaPos
+  (A.MINUS(A.DontCarePos,[],A.ALLMINUS,A.NOREPLACEMENT)),
+  []
 
 let generalize_mcode ia =
   let (s1, i, mck, pos) = ia in
@@ -146,13 +170,14 @@ let equal_c_int s1 s2 =
 let equal_unaryOp a b =
   match a, b with
   | A.GetRef   , B.GetRef  -> true
+  | A.GetRefLabel, B.GetRefLabel -> true
   | A.DeRef    , B.DeRef   -> true
   | A.UnPlus   , B.UnPlus  -> true
   | A.UnMinus  , B.UnMinus -> true
   | A.Tilde    , B.Tilde   -> true
   | A.Not      , B.Not     -> true
-  | _, B.GetRefLabel -> false (* todo cocci? *)
-  | _, (B.Not|B.Tilde|B.UnMinus|B.UnPlus|B.DeRef|B.GetRef) -> false
+  | _, (B.Not|B.Tilde|B.UnMinus|B.UnPlus|B.DeRef|B.GetRef|B.GetRefLabel) ->
+      false
 
 
 
@@ -256,6 +281,8 @@ let equal_metavarval valu valu' =
       Lib_parsing_c.al_statement a =*= Lib_parsing_c.al_statement b
   | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b ->
       Lib_parsing_c.al_init a =*= Lib_parsing_c.al_init b
+  | Ast_c.MetaInitListVal a, Ast_c.MetaInitListVal b ->
+      Lib_parsing_c.al_inits a =*= Lib_parsing_c.al_inits b
   | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b ->
       (* old: Lib_parsing_c.al_type a =*= Lib_parsing_c.al_type b *)
       C_vs_c.eq_type a b
@@ -282,7 +309,7 @@ let equal_metavarval valu valu' =
 
   | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _
       |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _ 
-      |B.MetaTypeVal _ |B.MetaInitVal _
+      |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaInitListVal _
       |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _
       |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _
     ), _
@@ -320,6 +347,8 @@ let equal_inh_metavarval valu valu'=
       Lib_parsing_c.al_inh_statement a =*= Lib_parsing_c.al_inh_statement b
   | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b ->
       Lib_parsing_c.al_inh_init a =*= Lib_parsing_c.al_inh_init b
+  | Ast_c.MetaInitListVal a, Ast_c.MetaInitListVal b ->
+      Lib_parsing_c.al_inh_inits a =*= Lib_parsing_c.al_inh_inits b
   | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b ->
       (* old: Lib_parsing_c.al_inh_type a =*= Lib_parsing_c.al_inh_type b *)
       C_vs_c.eq_type a b
@@ -346,7 +375,7 @@ let equal_inh_metavarval valu valu'=
 
   | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _
       |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _
-      |B.MetaTypeVal _ |B.MetaInitVal _
+      |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaInitListVal _
       |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _
       |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _
     ), _
@@ -709,6 +738,7 @@ but I don't know how to declare polymorphism across functors *)
 let dots2metavar (_,info,mcodekind,pos) =
   (("","..."),info,mcodekind,pos)
 let metavar2dots (_,info,mcodekind,pos) = ("...",info,mcodekind,pos)
+let metavar2ndots (_,info,mcodekind,pos) = ("<+...",info,mcodekind,pos)
 
 let satisfies_regexpconstraint c id : bool =
   match c with
@@ -856,8 +886,7 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma
                          if len = n
                          then (function f -> f())
                          else (function f -> fail)
-                     | A.AnyListLen -> function f -> f()
-                           )
+                     | A.AnyListLen -> function f -> f())
                        (fun () ->
                          let max_min _ =
                            Lib_parsing_c.lin_col_by_pos (get_iis startxs) in
@@ -1311,18 +1340,17 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) =
       ))))
 
   | A.NestExpr(starter,exps,ender,None,true), eb ->
-      (match A.get_mcodekind starter with
-       A.MINUS _ -> failwith "TODO: only context nests supported"
-      |        _ -> ());
       (match A.unwrap exps with
        A.DOTS [exp] ->
          X.cocciExpExp expression exp eb >>= (fun exp eb ->
+          X.distrf_e (dots2metavar starter) eb >>= (fun mcode eb ->
             return (
             (A.NestExpr
-              (starter,A.rewrap exps (A.DOTS [exp]),ender,None,true)) +> wa,
+              (metavar2ndots mcode,
+               A.rewrap exps (A.DOTS [exp]),ender,None,true)) +> wa,
             eb
             )
-         )
+         ))
       |        _ ->
          failwith
            "for nestexpr, only handling the case with dots and only one exp")
@@ -2300,16 +2328,20 @@ and initialisers_ordered2 = fun ias ibs ->
       A.IComma ia1 -> Some ia1
     |  _ -> None in
   let build_comma ia1 = A.IComma ia1 in
-  let match_metalist ea = None in
-  let build_metalist (ida,leninfo,keep,inherited) = failwith "not possible" in
-  let mktermval v = failwith "not possible" in
+  let match_metalist ea =
+    match A.unwrap ea with
+      A.MetaInitList(ida,leninfo,keep,inherited) ->
+       Some(ida,leninfo,keep,inherited)
+    | _ -> None in
+  let build_metalist (ida,leninfo,keep,inherited) =
+    A.MetaInitList(ida,leninfo,keep,inherited) in
+  let mktermval v = Ast_c.MetaInitListVal v in
   let special_cases ea eas ebs = None in
   let no_ii x = failwith "not possible" in
   list_matcher match_dots build_dots match_comma build_comma
     match_metalist build_metalist mktermval
     special_cases initialiser X.distrf_inis no_ii ias ibs
 
-
 and initialisers_unordered2 = fun allminus ias ibs ->
   match ias, ibs with
   | [], ys ->
@@ -3817,16 +3849,25 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) =
           F.SeqEnd (level, i1)
           ))
 
-  | A.ExprStatement (ea, ia1), F.ExprStatement (st, (Some eb, ii)) ->
+  | A.ExprStatement (Some ea, ia1), F.ExprStatement (st, (Some eb, ii)) ->
       let ib1 = tuple_of_list1 ii in
       expression ea eb >>= (fun ea eb ->
       tokenf ia1 ib1 >>= (fun ia1 ib1 ->
         return (
-          A.ExprStatement (ea, ia1),
+          A.ExprStatement (Some ea, ia1),
           F.ExprStatement (st, (Some eb, [ib1]))
         )
       ))
 
+  | A.ExprStatement (None, ia1), F.ExprStatement (st, (None, ii)) ->
+      let ib1 = tuple_of_list1 ii in
+      tokenf ia1 ib1 >>= (fun ia1 ib1 ->
+        return (
+          A.ExprStatement (None, ia1),
+          F.ExprStatement (st, (None, [ib1]))
+        )
+      )
+
 
   | A.IfHeader (ia1,ia2, ea, ia3), F.IfHeader (st, (eb,ii)) ->
       let (ib1, ib2, ib3) = tuple_of_list3 ii in