X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/90aeb998d88488b4402e7b211b064056d175fcbb..785a3008ddade80f642257bb47d43158ac8b8311:/engine/cocci_vs_c.ml diff --git a/engine/cocci_vs_c.ml b/engine/cocci_vs_c.ml index 5f0ad2a..90cdf8e 100644 --- a/engine/cocci_vs_c.ml +++ b/engine/cocci_vs_c.ml @@ -1,27 +1,3 @@ -(* - * 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, Julia Lawall * * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes @@ -276,6 +252,10 @@ let equal_metavarval valu valu' = | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> Lib_parsing_c.al_arguments a =*= Lib_parsing_c.al_arguments b + | Ast_c.MetaDeclVal a, Ast_c.MetaDeclVal b -> + Lib_parsing_c.al_declaration a =*= Lib_parsing_c.al_declaration b + | Ast_c.MetaFieldVal a, Ast_c.MetaFieldVal b -> + Lib_parsing_c.al_field a =*= Lib_parsing_c.al_field b | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> Lib_parsing_c.al_statement a =*= Lib_parsing_c.al_statement b | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> @@ -305,7 +285,7 @@ let equal_metavarval valu valu' = l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ - |B.MetaTypeVal _ |B.MetaInitVal _ + |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _ |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _ ), _ @@ -333,6 +313,10 @@ let equal_inh_metavarval valu valu'= | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> Lib_parsing_c.al_inh_arguments a =*= Lib_parsing_c.al_inh_arguments b + | Ast_c.MetaDeclVal a, Ast_c.MetaDeclVal b -> + Lib_parsing_c.al_inh_declaration a =*= Lib_parsing_c.al_inh_declaration b + | Ast_c.MetaFieldVal a, Ast_c.MetaFieldVal b -> + Lib_parsing_c.al_inh_field a =*= Lib_parsing_c.al_inh_field b | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> Lib_parsing_c.al_inh_statement a =*= Lib_parsing_c.al_inh_statement b | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> @@ -362,7 +346,7 @@ let equal_inh_metavarval valu valu'= l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ - |B.MetaTypeVal _ |B.MetaInitVal _ + |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _ |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _ ), _ @@ -628,6 +612,10 @@ module type PARAM = (A.meta_name A.mcode, Ast_c.parameterType) matcher val distrf_ini : (A.meta_name A.mcode, Ast_c.initialiser) matcher + val distrf_decl : + (A.meta_name A.mcode, Ast_c.declaration) matcher + val distrf_field : + (A.meta_name A.mcode, Ast_c.field) matcher val distrf_node : (A.meta_name A.mcode, Control_flow_c.node) matcher @@ -1449,11 +1437,15 @@ and arguments_bis = fun eas ebs -> let len = List.length startxs' in (match leninfo with - | Some (lenname,lenkeep,leninherited) -> + | A.MetaListLen (lenname,lenkeep,leninherited) -> let max_min _ = failwith "no pos" in X.envf lenkeep leninherited (lenname, Ast_c.MetaListlenVal (len), max_min) - | None -> function f -> f() + | A.CstListLen n -> + if len = n + then (function f -> f()) + else (function f -> fail) + | A.AnyListLen -> function f -> f() ) (fun () -> let max_min _ = @@ -1610,11 +1602,15 @@ and parameters_bis eas ebs = let len = List.length startxs' in (match leninfo with - Some (lenname,lenkeep,leninherited) -> + A.MetaListLen (lenname,lenkeep,leninherited) -> let max_min _ = failwith "no pos" in X.envf lenkeep leninherited (lenname, Ast_c.MetaListlenVal (len), max_min) - | None -> function f -> f() + | A.CstListLen n -> + if len = n + then (function f -> f()) + else (function f -> fail) + | A.AnyListLen -> function f -> f() ) (fun () -> let max_min _ = @@ -1769,12 +1765,15 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = * be no transform of MetaDecl, just matching are allowed. *) - | A.MetaDecl(ida,_keep,_inherited), _ -> (* keep ? inherited ? *) - (* todo: should not happen in transform mode *) - return ((mckstart, allminus, decla), declb) - - - + | A.MetaDecl (ida,keep,inherited), _ -> + let max_min _ = + Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_decl declb) in + X.envf keep inherited (ida, Ast_c.MetaDeclVal declb, max_min) (fun () -> + X.distrf_decl ida declb + ) >>= (fun ida declb -> + return ((mckstart, allminus, + (A.MetaDecl (ida, keep, inherited))+> A.rewrap decla), + declb)) | _, (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) -> onedecl allminus decla (var,iiptvirgb,iisto) >>= (fun decla (var,iiptvirgb,iisto)-> @@ -1827,7 +1826,7 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob)) )))))))) - | _, (B.MacroDecl _ |B.DeclList _) -> fail + | _, (B.MacroDecl _ |B.DeclList _) -> fail and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> @@ -1837,6 +1836,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> (* kind of typedef iso, we must unfold, it's for the case * T { }; that we want to match against typedef struct { } xx_t; *) + | A.TyDecl (tya0, ptvirga), ({B.v_namei = Some (nameidb, None); B.v_type = typb0; @@ -2417,8 +2417,16 @@ and (struct_fields: (A.declaration list, B.field list) matcher) = and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> - match fb with - | B.DeclarationField (B.FieldDeclList (onefield_multivars,iiptvirg)) -> + match A.unwrap fa,fb with + | A.MetaField (ida,keep,inherited), _ -> + let max_min _ = + Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_field fb) in + X.envf keep inherited (ida, Ast_c.MetaFieldVal fb, max_min) (fun () -> + X.distrf_field ida fb + ) >>= (fun ida fb -> + return ((A.MetaField (ida, keep, inherited))+> A.rewrap fa, + fb)) + | _,B.DeclarationField (B.FieldDeclList (onefield_multivars,iiptvirg)) -> let iiptvirgb = tuple_of_list1 iiptvirg in @@ -2476,16 +2484,15 @@ and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> pr2_once "PB: More that one variable in decl. Have to split"; fail ) - | B.EmptyField _iifield -> + | _,B.EmptyField _iifield -> fail - | B.MacroDeclField ((sb,ebs),ii) -> - (match A.unwrap fa with - A.MacroDecl (sa,lpa,eas,rpa,enda) -> raise Todo - | _ -> fail) + | A.MacroDecl (sa,lpa,eas,rpa,enda),B.MacroDeclField ((sb,ebs),ii) -> + raise Todo + | _,B.MacroDeclField ((sb,ebs),ii) -> fail - | B.CppDirectiveStruct directive -> fail - | B.IfdefStruct directive -> fail + | _,B.CppDirectiveStruct directive -> fail + | _,B.IfdefStruct directive -> fail