Coccinelle release 1.0.0-rc1
[bpt/coccinelle.git] / engine / pattern_c.ml
index 689f571..122717b 100644 (file)
  *)
 
 
-(*
- * 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.
- *)
-
-
-(* Yoann Padioleau
- *
- * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License (GPL)
- * version 2 as published by the Free Software Foundation.
- *
- * This program 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
- * file license.txt for more details.
- *
- * This file was part of Coccinelle.
- *)
 open Common
 
 module Flag_engine = Flag_matcher
@@ -461,6 +422,12 @@ module XMATCH = struct
                   (if strip
                   then Lib_parsing_c.al_field a
                   else Lib_parsing_c.semi_al_field a))
+          | Ast_c.MetaFieldListVal a ->
+             success
+               (Ast_c.MetaFieldListVal
+                  (if strip
+                  then Lib_parsing_c.al_fields a
+                  else Lib_parsing_c.semi_al_fields a))
           | Ast_c.MetaStmtVal a ->
              success
                (Ast_c.MetaStmtVal
@@ -481,6 +448,13 @@ module XMATCH = struct
                   then Lib_parsing_c.al_init a
                   else Lib_parsing_c.semi_al_init a))
                
+          | Ast_c.MetaInitListVal a ->
+             success
+               (Ast_c.MetaInitListVal
+                  (if strip
+                  then Lib_parsing_c.al_inits a
+                  else Lib_parsing_c.semi_al_inits a))
+               
           | Ast_c.MetaListlenVal a -> success(Ast_c.MetaListlenVal a)
                
           | Ast_c.MetaParamVal a ->
@@ -500,33 +474,39 @@ module XMATCH = struct
              success(Ast_c.MetaPosVal (pos1,pos2))
           | Ast_c.MetaPosValList l -> success (Ast_c.MetaPosValList l))
 
+  let pos_variables tin ia get_pvalu finish =
+    match Ast_cocci.get_pos_var ia with
+      [] -> finish tin
+    | positions ->
+       let pvalu = Ast_c.MetaPosValList(get_pvalu()) in
+       let rec loop tin = function
+           [] -> finish tin
+         | Ast_cocci.MetaPos(name,constraints,per,keep,inherited) :: rest ->
+             check_pos_constraints constraints pvalu
+               (function () ->
+           (* constraints are satisfied, now see if we are compatible
+              with existing bindings *)
+                 function new_tin ->
+                   let x = Ast_cocci.unwrap_mcode name in
+                   let new_binding =
+                     check_add_metavars_binding false keep inherited
+                       (x, pvalu) tin in
+                   (match  new_binding with
+                     Some binding -> loop {tin with binding = binding} rest
+                   | None -> fail tin))
+               tin in
+       loop tin positions
+
   let envf keep inherited = fun (k, valu, get_max_min) f tin ->
     let x = Ast_cocci.unwrap_mcode k in
     match check_add_metavars_binding true keep inherited (x, valu) tin with
     | Some binding ->
        let new_tin = {tin with binding = binding} in
-       (match Ast_cocci.get_pos_var k with
-         Ast_cocci.MetaPos(name,constraints,per,keep,inherited) ->
-           let pvalu =
-             let (file,current_element,min,max) = get_max_min() in
-             Ast_c.MetaPosValList[(file,current_element,min,max)] in
-           (* check constraints.  success means that there is a match with
-              one of the constraints, which will ultimately result in
-              failure. *)
-           check_pos_constraints constraints pvalu
-             (function () ->
-               (* constraints are satisfied, now see if we are compatible
-                  with existing bindings *)
-               function new_tin ->
-                 let x = Ast_cocci.unwrap_mcode name in
-                 (match
-                   check_add_metavars_binding false keep inherited (x, pvalu)
-                     new_tin with
-                 | Some binding ->
-                     f () {new_tin with binding = binding}
-                 | None -> fail tin))
-             new_tin
-       | Ast_cocci.NoMetaPos -> f () new_tin)
+       pos_variables new_tin k
+         (function _ ->
+           let (file,current_element,min,max) = get_max_min() in
+           [(file,current_element,min,max)])
+         (f ())
     | None -> fail tin
 
   (* ------------------------------------------------------------------------*)
@@ -556,7 +536,6 @@ module XMATCH = struct
   let value_format_flag f = fun tin ->
     f (tin.extra.value_format_iso) tin
 
-
   (* ------------------------------------------------------------------------*)
   (* Tokens *)
   (* ------------------------------------------------------------------------*)
@@ -564,24 +543,9 @@ module XMATCH = struct
     let pos = Ast_c.info_to_fixpos ib in
     let posmck = Ast_cocci.FixPos (pos, pos) in
     let finish tin = tag_mck_pos_mcode ia posmck ib tin in
-    match Ast_cocci.get_pos_var ia with
-      Ast_cocci.MetaPos(name,constraints,per,keep,inherited) ->
-       let mpos = Lib_parsing_c.lin_col_by_pos [ib] in
-       let pvalu = Ast_c.MetaPosValList [mpos] in
-       check_pos_constraints constraints pvalu
-         (function () ->
-           (* constraints are satisfied, now see if we are compatible
-              with existing bindings *)
-           function new_tin ->
-             let x = Ast_cocci.unwrap_mcode name in
-             (match
-               check_add_metavars_binding false keep inherited (x, pvalu) tin
-             with
-               Some binding -> finish {tin with binding = binding}
-             | None -> fail tin))
-         tin
-    | _ -> finish tin
-
+    pos_variables tin ia (function _ -> [Lib_parsing_c.lin_col_by_pos [ib]])
+      finish
+      
   let tokenf_mck mck ib = fun tin ->
     let pos = Ast_c.info_to_fixpos ib in
     let posmck = Ast_cocci.FixPos (pos, pos) in