X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/6756e19d8b45188ff250016a494aafe46dec86c5..65038c617fe3e5d7a284059fbfa78dddfbb9b9c4:/engine/cocci_vs_c.ml diff --git a/engine/cocci_vs_c.ml b/engine/cocci_vs_c.ml index 3ac63b5..a5e297c 100644 --- a/engine/cocci_vs_c.ml +++ b/engine/cocci_vs_c.ml @@ -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 . + * + * 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