X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/6756e19d8b45188ff250016a494aafe46dec86c5..17ba07880e1838028b4516ba7a2db2147b3aa1c9:/engine/cocci_vs_c.ml diff --git a/engine/cocci_vs_c.ml b/engine/cocci_vs_c.ml index 3ac63b5..8dae6dc 100644 --- a/engine/cocci_vs_c.ml +++ b/engine/cocci_vs_c.ml @@ -1,3 +1,29 @@ +(* + * Copyright 2012, INRIA + * Julia Lawall, Gilles Muller + * Copyright 2010-2011, 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 +107,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 @@ -100,9 +126,9 @@ 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.line = 0; A.column =0; A.strbef=[]; A.straft=[]}, + (A.MINUS(A.DontCarePos,[],A.ALLMINUS,A.NOREPLACEMENT)), + [] let generalize_mcode ia = let (s1, i, mck, pos) = ia in @@ -146,13 +172,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 +283,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 @@ -281,8 +310,8 @@ let equal_metavarval valu valu' = l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ - |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _ - |B.MetaTypeVal _ |B.MetaInitVal _ + |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _ + |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaInitListVal _ |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _ |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _ ), _ @@ -320,6 +349,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 +377,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 _ ), _ @@ -501,7 +532,9 @@ let one_initialisation_to_affectation x = match local with Ast_c.NotLocalDecl -> Ast_c.NotLocalVar | Ast_c.LocalDecl -> - Ast_c.LocalVar (Ast_c.info_of_type returnType) in + (match Ast_c.info_of_type returnType with + None -> failwith "no returnType info" + | Some ii -> Ast_c.LocalVar ii) in let typexp = (* old: Lib_parsing_c.al_type returnType * but this type has not the typename completed so @@ -511,7 +544,7 @@ let one_initialisation_to_affectation x = | Some ty_with_typename_completed -> ty_with_typename_completed | None -> raise Impossible in - + let typ = ref (Some (typexp,local), Ast_c.NotTest) in let ident = name in let idexpr = Ast_c.mk_e_bis (B.Ident ident) typ Ast_c.noii in @@ -519,11 +552,12 @@ let one_initialisation_to_affectation x = Ast_c.mk_e (B.Assignment (idexpr,B.SimpleAssign, e)) [iini] in Some assign | _ -> None) - | _ -> None - + | _ -> None + let initialisation_to_affectation decl = match decl with | B.MacroDecl _ -> F.Decl decl + | B.MacroDeclInit _ -> F.Decl decl (* not sure... *) | B.DeclList (xs, iis) -> (* todo?: should not do that if the variable is an array cos @@ -662,7 +696,9 @@ module type PARAM = val optional_storage_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val optional_qualifier_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) - val value_format_flag: (bool -> tin -> 'x tout) -> (tin -> 'x tout) + val value_format_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) + val optional_declarer_semicolon_flag : + (bool -> tin -> 'x tout) -> (tin -> 'x tout) end @@ -709,11 +745,12 @@ 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 - A.IdRegExp (_,recompiled) -> Str.string_match recompiled id 0 - | A.IdNotRegExp (_,recompiled) -> not (Str.string_match recompiled id 0) + A.IdRegExp (_,recompiled) -> Regexp.string_match recompiled id + | A.IdNotRegExp (_,recompiled) -> not (Regexp.string_match recompiled id) let satisfies_iconstraint c id : bool = not (List.mem id c) @@ -738,7 +775,7 @@ let satisfies_econstraint c exp : bool = (match cst with | Ast_c.String (str, _) -> satisfies_regexpconstraint c str | Ast_c.MultiString strlist -> - warning "Unable to apply a constraint on an multistring constant!" + warning "Unable to apply a constraint on a multistring constant!" | Ast_c.Char (char , _) -> satisfies_regexpconstraint c char | Ast_c.Int (int , _) -> satisfies_regexpconstraint c int | Ast_c.Float (float, _) -> satisfies_regexpconstraint c float) @@ -761,14 +798,23 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma Some (mcode, optexpr), ys -> (* todo: if optexpr, then a WHEN and so may have to filter yys *) if optexpr <> None then failwith "not handling when in a list"; - + (* '...' can take more or less the beginnings of the arguments *) let startendxs = - Common.zip (Common.inits ys) (Common.tails ys) in + (* if eas is empty there is only one possible match. + the same if eas is just a comma *) + match eas with + [] -> [(ys,[])] + | [c] when not(ys=[]) && + (match match_comma c with Some _ -> true | None -> false) -> + let r = List.rev ys in + [(List.rev(List.tl r),[List.hd r])] + | _ -> + Common.zip (Common.inits ys) (Common.tails ys) in Some (startendxs +> List.fold_left (fun acc (startxs, endxs) -> acc >||> ( - + (* allow '...', and maybe its associated ',' to match nothing. * for the associated ',' see below how we handle the EComma * to match nothing. @@ -790,7 +836,7 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma (match Common.last startxs with | Right _ -> fail | Left _ -> distrf (dots2metavar mcode) startxs)) - + >>= (fun mcode startxs -> let mcode = metavar2dots mcode in loop (eas, endxs) >>= (fun eas endxs -> @@ -800,7 +846,7 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma ))) ) ) fail) - + | None,_ -> None) +++ (match match_comma ea, ebs with @@ -846,7 +892,7 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma else let startxs' = Ast_c.unsplit_comma startxs in let len = List.length startxs' in - + (match leninfo with | A.MetaListLen (lenname,lenkeep,leninherited) -> let max_min _ = failwith "no pos" in @@ -856,8 +902,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 @@ -1000,6 +1045,12 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = * any checks. Hopefully now have tagged SP technique. *) + | A.AsExpr(exp,asexp), expb -> + expression exp expb >>= (fun exp expb -> + expression asexp expb >>= (fun asexp expb -> + return( + ((A.AsExpr(exp,asexp)) +> wa, + expb)))) (* old: * | A.Edots _, _ -> raise Impossible. @@ -1103,9 +1154,6 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = ((B.FunCall (eb, ebs),typ), [ib1;ib2]) )))))) - - - | A.Assignment (ea1, opa, ea2, simple), ((B.Assignment (eb1, opb, eb2), typ),ii) -> let (opbi) = tuple_of_list1 ii in @@ -1120,6 +1168,17 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = )))) else fail + | A.Sequence (ea1, opa, ea2), + ((B.Sequence (eb1, eb2), typ),ii) -> + let (opbi) = tuple_of_list1 ii in + expression ea1 eb1 >>= (fun ea1 eb1 -> + expression ea2 eb2 >>= (fun ea2 eb2 -> + tokenf opa opbi >>= (fun opa opbi -> + return ( + (A.Sequence (ea1, opa, ea2)) +> wa, + ((B.Sequence (eb1, eb2), typ), [opbi]) + )))) + | A.CondExpr(ea1,ia1,ea2opt,ia2,ea3),((B.CondExpr(eb1,eb2opt,eb3),typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in expression ea1 eb1 >>= (fun ea1 eb1 -> @@ -1207,17 +1266,19 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in let in_left = - (loop eb1 >>= (fun ea1 eb1 -> - expression ea2 eb2 >>= (fun ea2 eb2 -> - tokenf opa opbi >>= (fun opa opbi -> + (expression ea2 eb2 >>= (fun ea2 eb2 -> + tokenf opa opbi >>= (fun opa opbi -> + (* be last, to be sure the rest is marked *) + loop eb1 >>= (fun ea1 eb1 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in let in_right = (expression ea2 eb1 >>= (fun ea2 eb1 -> - loop eb2 >>= (fun ea1 eb2 -> - tokenf opa opbi >>= (fun opa opbi -> + tokenf opa opbi >>= (fun opa opbi -> + (* be last, to be sure the rest is marked *) + loop eb2 >>= (fun ea1 eb2 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] @@ -1311,18 +1372,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") @@ -1333,6 +1393,17 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = (* only in arg lists or in define body *) | A.TypeExp _, _ -> fail + | A.Constructor (ia1, typa, ia2, ia), ((B.Constructor (typb, ib), typ),ii) -> + let (ib1, ib2) = tuple_of_list2 ii in + fullType typa typb >>= (fun typa typb -> + initialiser ia ib >>= (fun ia ib -> + tokenf ia1 ib1 >>= (fun ia1 ib1 -> + tokenf ia2 ib2 >>= (fun ia2 ib2 -> + return ( + ((A.Constructor (ia1, typa, ia2, ia))) +> wa, + ((B.Constructor (typb, ib),typ),[ib1;ib2]) + ))))) + (* only in arg lists *) | A.MetaExprList _, _ | A.EComma _, _ @@ -1352,7 +1423,6 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = (* have not a counter part in coccinelle, for the moment *) | _, ((B.Sequence _,_),_) | _, ((B.StatementExpr _,_),_) - | _, ((B.Constructor _,_),_) | _, ((B.New _,_),_) | _, ((B.Delete _,_),_) -> fail @@ -1360,6 +1430,7 @@ let rec (expression: (A.expression, Ast_c.expression) matcher) = | _, (((B.Cast (_, _)|B.ParenExpr _|B.SizeOfType _|B.SizeOfExpr _| + B.Constructor (_, _)| B.RecordPtAccess (_, _)| B.RecordAccess (_, _)|B.ArrayAccess (_, _)| B.Binary (_, _, _)|B.Unary (_, _)| @@ -1478,7 +1549,7 @@ and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) = | A.OptIdent _ | A.UniqueIdent _ -> failwith "not handling Opt/Unique for ident" - + (* ------------------------------------------------------------------------- *) and (arguments: sequence -> (A.expression list, Ast_c.argument Ast_c.wrap2 list) matcher) = @@ -1496,12 +1567,12 @@ and (arguments: sequence -> * in the Ecomma matching rule. * * old: Must do some try, for instance when f(...,X,Y,...) have to - * test the transfo for all the combinaitions and if multiple transfo + * test the transfo for all the combinations and if multiple transfo * possible ? pb ? => the type is to return a expression option ? use * some combinators to help ? * update: with the tag-SP approach, no more a problem. *) - + and arguments_bis = fun eas ebs -> let match_dots ea = match A.unwrap ea with @@ -1598,7 +1669,7 @@ and parameters_bis eas ebs = let {B.p_register=(hasreg,iihasreg); p_namei = idbopt; p_type=tb; } = eb in - + if idbopt =*= None && not hasreg then match tb with @@ -1618,7 +1689,7 @@ and parameters_bis eas ebs = match_metalist build_metalist mktermval special_cases parameter X.distrf_params Lib_parsing_c.ii_of_params eas ebs - + (* let split_register_param = fun (hasreg, idb, ii_b_s) -> match hasreg, idb, ii_b_s with @@ -1627,8 +1698,8 @@ and parameters_bis eas ebs = | _, None, ii -> Right ii | _ -> raise Impossible *) - - + + and parameter = fun parama paramb -> match A.unwrap parama, paramb with A.MetaParam (ida,keep,inherited), eb -> @@ -1643,7 +1714,7 @@ and parameter = fun parama paramb -> let {B.p_register = (hasreg,iihasreg); p_namei = nameidbopt; p_type = typb;} = paramb in - + fullType typa typb >>= (fun typa typb -> match idaopt, nameidbopt with | Some ida, Some nameidb -> @@ -1655,7 +1726,7 @@ and parameter = fun parama paramb -> p_namei = Some (nameidb); p_type = typb} )) - + | None, None -> return ( A.Param (typa, None)+> A.rewrap parama, @@ -1678,7 +1749,7 @@ and parameter = fun parama paramb -> | Some _, None -> fail | None, Some _ -> fail) | (A.OptParam _ | A.UniqueParam _), _ -> - failwith "not handling Opt/Unique for Param" + failwith "not handling Opt/Unique for Param" | A.Pcircles (_), ys -> raise Impossible (* in Ordered mode *) | _ -> fail @@ -1708,6 +1779,17 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = return ((mckstart, allminus, (A.MetaDecl (ida, keep, inherited))+> A.rewrap decla), declb)) + + | A.AsDecl(dec,asdec), decb -> + declaration (mckstart, allminus, dec) decb >>= + (fun (mckstart, allminus, dec) decb -> + let asmckstart = A.CONTEXT(A.NoPos,A.NOTHING) in + declaration (asmckstart,false,asdec) decb >>= (fun (_,_,asdec) decb -> + return( + ((mckstart, allminus, + (A.AsDecl(dec,asdec)) +> A.rewrap decla), + decb)))) + | _, (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) -> onedecl allminus decla (var,iiptvirgb,iisto) >>= (fun decla (var,iiptvirgb,iisto)-> @@ -1746,7 +1828,7 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = error ii "More than one variable in the declaration, and so it cannot be transformed. Check that there is no transformation on the type or the ;" - | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs),ii) -> + | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs,true),ii) -> let (iisb, lpb, rpb, iiendb, iifakestart, iistob) = (match ii with | iisb::lpb::rpb::iiendb::iifakestart::iisto -> @@ -1769,11 +1851,72 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = return ( (mckstart, allminus, (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), - (B.MacroDecl ((sb,ebs), + (B.MacroDecl ((sb,ebs,true), [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob)) )))))))) - | _, (B.MacroDecl _ |B.DeclList _) -> fail + | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs,false),ii) -> + X.optional_declarer_semicolon_flag (fun optional_declarer_semicolon -> + match mcodekind enda, optional_declarer_semicolon with + A.CONTEXT (_,A.NOTHING), true -> + let (iisb, lpb, rpb, iifakestart, iistob) = + (match ii with + | iisb::lpb::rpb::iifakestart::iisto -> + (iisb,lpb,rpb,iifakestart,iisto) + | _ -> raise Impossible) in + (if allminus + then minusize_list iistob + else return ((), iistob)) >>= + (fun () iistob -> + + X.tokenf_mck mckstart iifakestart >>= + (fun mckstart iifakestart -> + ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) -> + tokenf lpa lpb >>= (fun lpa lpb -> + tokenf rpa rpb >>= (fun rpa rpb -> + arguments (seqstyle eas) (A.undots eas) ebs >>= + (fun easundots ebs -> + let eas = redots eas easundots in + + return ( + (mckstart, allminus, + (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), + (B.MacroDecl ((sb,ebs,false), + [iisb;lpb;rpb;iifakestart] ++ iistob)) + ))))))) + | _ -> fail) + + | A.MacroDeclInit (sa,lpa,eas,rpa,weqa,inia,enda), + B.MacroDeclInit ((sb,ebs,inib),ii) -> + let (iisb, lpb, rpb, weqb, iiendb, iifakestart, iistob) = + (match ii with + | iisb::lpb::rpb::weqb::iiendb::iifakestart::iisto -> + (iisb,lpb,rpb,weqb,iiendb, iifakestart,iisto) + | _ -> raise Impossible + ) in + (if allminus + then minusize_list iistob + else return ((), iistob) + ) >>= (fun () iistob -> + + X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> + ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) -> + tokenf lpa lpb >>= (fun lpa lpb -> + tokenf rpa rpb >>= (fun rpa rpb -> + tokenf rpa rpb >>= (fun rpa rpb -> + tokenf weqa weqb >>= (fun weqa weqb -> + tokenf enda iiendb >>= (fun enda iiendb -> + arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> + initialiser inia inib >>= (fun inia inib -> + let eas = redots eas easundots in + + return ( + (mckstart, allminus, + (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), + (B.MacroDecl ((sb,ebs,true), + [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob)) + ))))))))))) + | _, (B.MacroDecl _ |B.MacroDeclInit _ |B.DeclList _) -> fail and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> @@ -1794,7 +1937,8 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> }, iivirg) -> (match A.unwrap tya0, typb0 with - | A.Type(cv1,tya1), ((qu,il),typb1) -> + | A.Type(allminus,cv1,tya1), ((qu,il),typb1) -> + (* allminus doesn't seem useful here - nothing done with cv1 *) (match A.unwrap tya1, typb1 with | A.StructUnionDef(tya2, lba, declsa, rba), @@ -1830,14 +1974,14 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> let declsa = redots declsa undeclsa in (match A.unwrap tya2 with - | A.Type(cv3, tya3) -> + | A.Type(allminus, cv3, tya3) -> (* again allminus not used *) (match A.unwrap tya3 with | A.MetaType(ida,keep, inherited) -> fullType tya2 fake_typeb >>= (fun tya2 fake_typeb -> let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in - let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in + let tya0 = A.Type(allminus, cv1, tya1) +> A.rewrap tya0 in let typb1 = B.StructUnion (sub,sbopt, declsb), @@ -1867,7 +2011,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in - let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in + let tya0 = A.Type(allminus, cv1, tya1) +> A.rewrap tya0 in match structnameb with | _nQ, (B.StructUnionName (sub, s), [iisub;iisbopt]) -> @@ -2111,6 +2255,13 @@ and (initialiser: (A.initialiser, Ast_c.initialiser) matcher) = fun ia ib -> )) ) + | A.AsInit(ini,asini), inib -> + initialiser ini inib >>= (fun ini inib -> + initialiser asini inib >>= (fun asini inib -> + return( + ((A.AsInit(ini,asini)) +> A.rewrap ia, + inib)))) + | (A.InitExpr expa, ib) -> (match A.unwrap expa, ib with | A.Edots (mcode, None), ib -> @@ -2266,7 +2417,8 @@ and str_initialisers = fun allminus ias (ibs, iicomma) -> let ibs_split = resplit_initialiser ibs iicomma in if need_unordered_initialisers ibs - then initialisers_unordered2 allminus ias_unsplit ibs_split >>= + then + initialisers_unordered2 allminus ias_unsplit ibs_split >>= (fun ias_unsplit ibs_split -> return ( split_icomma ias_unsplit, @@ -2282,6 +2434,7 @@ and ar_initialisers = fun ias (ibs, iicomma) -> (List.map (function (elem,comma) -> [Left elem; Right [comma]]) ibs) in initialisers_ordered2 ias ibs >>= (fun ias ibs_split -> + let ibs,iicomma = match List.rev ibs_split with (Right comma)::rest -> (Ast_c.unsplit_comma (List.rev rest),comma) @@ -2300,16 +2453,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 -> @@ -2407,7 +2564,7 @@ and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> pr2_once "warning: bitfield not handled by ast_cocci"; fail | B.Simple (None, typb) -> - pr2_once "warning: unamed struct field not handled by ast_cocci"; + pr2_once "warning: unnamed struct field not handled by ast_cocci"; fail | B.Simple (Some nameidb, typb) -> @@ -2508,7 +2665,7 @@ and (fullType: (A.fullType, Ast_c.fullType) matcher) = X.optional_qualifier_flag (fun optional_qualifier -> X.all_bound (A.get_inherited typa) >&&> match A.unwrap typa, typb with - | A.Type(cv,ty1), ((qu,il),ty2) -> + | A.Type(allminus,cv,ty1), ((qu,il),ty2) -> if qu.B.const && qu.B.volatile then @@ -2527,11 +2684,15 @@ and (fullType: (A.fullType, Ast_c.fullType) matcher) = (* "iso-by-absence" *) | None -> let do_stuff () = - fullTypebis ty1 ((qu,il), ty2) >>= (fun ty1 fullty2 -> - return ( - (A.Type(None, ty1)) +> A.rewrap typa, - fullty2 - )) + fullTypebis ty1 ((qu,il), ty2) >>= (fun ty1 ((qu,il), ty2) -> + (if allminus + then minusize_list il + else return ((), il) + ) >>= (fun () il -> + return ( + (A.Type(allminus, None, ty1)) +> A.rewrap typa, + ((qu,il), ty2) + ))) in (match optional_qualifier, qu.B.const || qu.B.volatile with | false, false -> do_stuff () @@ -2554,7 +2715,7 @@ and (fullType: (A.fullType, Ast_c.fullType) matcher) = tokenf x i1 >>= (fun x i1 -> fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> return ( - (A.Type(Some x, ty1)) +> A.rewrap typa, + (A.Type(allminus, Some x, ty1)) +> A.rewrap typa, ((qu, [i1]), ty2) ))) @@ -2562,7 +2723,7 @@ and (fullType: (A.fullType, Ast_c.fullType) matcher) = tokenf x i1 >>= (fun x i1 -> fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> return ( - (A.Type(Some x, ty1)) +> A.rewrap typa, + (A.Type(allminus, Some x, ty1)) +> A.rewrap typa, ((qu, [i1]), ty2) ))) @@ -2570,6 +2731,13 @@ and (fullType: (A.fullType, Ast_c.fullType) matcher) = ) ) + | A.AsType(ty,asty), tyb -> + fullType ty tyb >>= (fun ty tyb -> + fullType asty tyb >>= (fun asty tyb -> + return( + ((A.AsType(ty,asty)) +> A.rewrap typa, + tyb)))) + | A.DisjType typas, typb -> typas +> List.fold_left (fun acc typa -> acc >|+|> (fullType typa typb)) fail @@ -2611,7 +2779,7 @@ and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda = (* In ii there is a list, sometimes of length 1 or 2 or 3. * And even if in baseb we have a Signed Int, that does not mean * that ii is of length 2, cos Signed is the default, so if in signa - * we have Signed explicitely ? we cant "accrocher" this mcode to + * we have Signed explicitly ? we cant "accrocher" this mcode to * something :( So for the moment when there is signed in cocci, * we force that there is a signed in c too (done in pattern.ml). *) @@ -2675,8 +2843,8 @@ and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda = | [x;y] -> - pr2_once - "warning: long int or short int not handled by ast_cocci"; + (*pr2_once + "warning: long int or short int not handled by ast_cocci";*) fail | [ibaseb] -> @@ -2690,8 +2858,27 @@ and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda = ) + | A.LongLongIntType, B.IntType (B.Si (_, B.CLongLong)) -> + let (string1a,string2a,string3a) = tuple_of_list3 stringsa in + (match iibaseb with + [ibase1b;ibase2b;ibase3b] -> + sign signaopt signbopt >>= (fun signaopt iisignbopt -> + tokenf string1a ibase1b >>= (fun base1a ibase1b -> + tokenf string2a ibase2b >>= (fun base2a ibase2b -> + tokenf string3a ibase3b >>= (fun base3a ibase3b -> + return ( + (rebuilda ([base1a;base2a;base3a], signaopt)) +> A.rewrap ta, + (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b;ibase3b]) + ))))) + | [ibase1b;ibase2b] -> fail (* int omitted *) + | [] -> fail (* should something be done in this case? *) + | _ -> raise Impossible) + - | A.LongLongType, B.IntType (B.Si (_, B.CLongLong)) -> + | A.LongLongType, B.IntType (B.Si (_, B.CLongLong)) + | A.LongIntType, B.IntType (B.Si (_, B.CLong)) + | A.ShortIntType, B.IntType (B.Si (_, B.CShort)) + | A.LongDoubleType, B.FloatType B.CLongDouble -> let (string1a,string2a) = tuple_of_list2 stringsa in (match iibaseb with [ibase1b;ibase2b] -> @@ -2702,16 +2889,11 @@ and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda = (rebuilda ([base1a;base2a], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b]) )))) + | [ibase1b] -> fail (* short or long *) + | [ibase1b;ibase2b;ibase3b] -> fail (* long long case *) | [] -> fail (* should something be done in this case? *) | _ -> raise Impossible) - - | _, B.FloatType B.CLongDouble - -> - pr2_once - "warning: long double not handled by ast_cocci"; - fail - | _, (B.Void|B.FloatType _|B.IntType _ |B.SizeType|B.SSizeType|B.PtrDiffType) -> fail @@ -2727,11 +2909,11 @@ and simulate_signed_meta ta basea signaopt tb baseb ii rebuilda = let match_to_type rebaseb = sign signaopt signbopt >>= (fun signaopt iisignbopt -> - let fta = A.rewrap basea (A.Type(None,basea)) in + let fta = A.rewrap basea (A.Type(false(*don't know*),None,basea)) in let ftb = Ast_c.nQ,(B.BaseType (rebaseb), iibaseb) in fullType fta ftb >>= (fun fta (_,tb) -> (match A.unwrap fta,tb with - A.Type(_,basea), (B.BaseType baseb, ii) -> + A.Type(_,_,basea), (B.BaseType baseb, ii) -> return ( (rebuilda (basea, signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ ii) @@ -2883,7 +3065,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = - (* todo: handle the iso on optionnal size specifification ? *) + (* todo: handle the iso on optional size specification ? *) | A.Array (typa, ia1, eaopt, ia2), (B.Array (ebopt, typb), ii) -> let (ib1, ib2) = tuple_of_list2 ii in fullType typa typb >>= (fun typa typb -> @@ -2931,7 +3113,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = the part that matched *) let rec loop s = match A.unwrap s with - A.Type(None,ty) -> + A.Type(allminus,None,ty) -> (match A.unwrap ty with A.StructUnionName(sua, None) -> (match (term sua, sub) with @@ -2941,7 +3123,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = (fun _ _ -> tokenf sua iisub >>= (fun sua iisub -> let ty = - A.Type(None, + A.Type(allminus,None, A.StructUnionName(sua, None) +> A.rewrap ty) +> A.rewrap s in return (ty,[iisub]))) @@ -3035,12 +3217,13 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = the part that matched *) let rec loop s = match A.unwrap s with - A.Type(None,ty) -> + A.Type(allminus,None,ty) -> (match A.unwrap ty with A.EnumName(sua, None) -> tokenf sua iisub >>= (fun sua iisub -> let ty = - A.Type(None,A.EnumName(sua, None) +> A.rewrap ty) + A.Type(allminus,None,A.EnumName(sua, None) +> + A.rewrap ty) +> A.rewrap s in return (ty,[iisub])) | _ -> fail) @@ -3157,7 +3340,7 @@ and storage_optional_allminus allminus stoa (stob, iistob) = | i1::iistob -> let str = B.str_of_info i1 in (match str with - "static" | "extern" | "auto" | "register" -> + "static" | "extern" | "auto" | "register" -> (* not very elegant, but tokenf doesn't know what token to match with *) tokenf x i1 >>= (fun x i1 -> @@ -3202,7 +3385,7 @@ and inline_optional_allminus allminus inla (stob, iistob) = | i1::iistob -> let str = B.str_of_info i1 in (match str with - "inline" -> + "inline" -> (* not very elegant, but tokenf doesn't know what token to match with *) tokenf x i1 >>= (fun x i1 -> @@ -3252,9 +3435,8 @@ and compatible_base_type a signa b = compatible_sign signa signb | Type_cocci.LongType, B.IntType (B.Si (signb, B.CLong)) -> compatible_sign signa signb - | _, B.IntType (B.Si (signb, B.CLongLong)) -> - pr2_once "no longlong in cocci"; - fail + | Type_cocci.LongLongType, B.IntType (B.Si (signb, B.CLongLong)) -> + compatible_sign signa signb | Type_cocci.FloatType, B.FloatType B.CFloat -> assert (signa =*= None); ok @@ -3313,7 +3495,7 @@ and compatible_type a (b,local) = loop (a,b) | Type_cocci.FunctionPointer a, _ -> failwith - "TODO: function pointer type doesn't store enough information to determine compatability" + "TODO: function pointer type doesn't store enough information to determine compatibility" | Type_cocci.Array a, (qub, (B.Array (eopt, b),ii)) -> (* no size info for cocci *) loop (a,b) @@ -3789,11 +3971,6 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = | _ -> raise Impossible ) - - - - - | A.Decl (mckstart,allminus,decla), F.Decl declb -> declaration (mckstart,allminus,decla) declb >>= (fun (mckstart,allminus,decla) declb -> @@ -3817,16 +3994,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 @@ -4090,6 +4276,7 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = (* todo?: print a warning at least ? *) | _, F.CaseRange _ | _, F.Asm _ + -> fail2() | _, F.MacroTop _ -> fail2() @@ -4114,4 +4301,3 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = ) end -