X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/9bc82bae75129fec4d981ebf245f2f7d7ca73a41..8f657093d128c6436330659d273c2762ac9cbf79:/engine/pattern_c.ml diff --git a/engine/pattern_c.ml b/engine/pattern_c.ml index 689f571..122717b 100644 --- a/engine/pattern_c.ml +++ b/engine/pattern_c.ml @@ -22,45 +22,6 @@ *) -(* - * 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 . - * - * 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