X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/690d68d19cb322bc18140b6406e298038dcf47f2..feec80c30d140c69f5d894bd09b6071247d0fbaa:/engine/cocci_vs_c.ml diff --git a/engine/cocci_vs_c.ml b/engine/cocci_vs_c.ml index d09bd4c..e8786c0 100644 --- a/engine/cocci_vs_c.ml +++ b/engine/cocci_vs_c.ml @@ -1,5 +1,7 @@ (* - * Copyright 2010, INRIA, University of Copenhagen + * 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 @@ -22,6 +24,7 @@ *) +# 0 "./cocci_vs_c.ml" open Common module A = Ast_cocci @@ -38,6 +41,14 @@ let pr2, pr2_once = Common.mk_pr2_wrappers Flag_matcher.verbose_matcher let (+++) a b = match a with Some x -> Some x | None -> b +let error ii str = + match ii with + [] -> failwith str + | ii::_ -> + failwith + (Printf.sprintf "%s: %d: %s" + (Ast_c.file_of_info ii) (Ast_c.line_of_info ii) str) + (*****************************************************************************) (* Helpers *) (*****************************************************************************) @@ -97,12 +108,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 @@ -116,9 +127,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 @@ -162,13 +173,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 @@ -266,10 +278,14 @@ let equal_metavarval valu valu' = 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.MetaFieldListVal a, Ast_c.MetaFieldListVal b -> + Lib_parsing_c.al_fields a =*= Lib_parsing_c.al_fields 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 -> 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 @@ -295,7 +311,8 @@ let equal_metavarval valu valu' = l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ - |B.MetaDeclVal _ |B.MetaFieldVal _ |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 _ ), _ @@ -327,10 +344,14 @@ let equal_inh_metavarval valu valu'= 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.MetaFieldListVal a, Ast_c.MetaFieldListVal b -> + Lib_parsing_c.al_inh_field_list a =*= Lib_parsing_c.al_inh_field_list 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 -> 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 @@ -356,7 +377,8 @@ let equal_inh_metavarval valu valu'= l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ - |B.MetaDeclVal _ |B.MetaFieldVal _ |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 _ ), _ @@ -397,8 +419,8 @@ let split_signb_baseb_ii (baseb, ii) = | B.CInt, ["",i1] -> (* no type is specified at all *) (match i1.B.pinfo with B.FakeTok(_,_) -> [] - | _ -> failwith ("unrecognized signed int: "^ - (String.concat " "(List.map fst iis)))) + | _ -> error [i1] ("unrecognized signed int: "^ + (String.concat " "(List.map fst iis)))) | B.CChar2, ["char",i2] -> [i2] @@ -412,16 +434,19 @@ let split_signb_baseb_ii (baseb, ii) = | B.CLongLong, ["long",i1;"long",i2;"int",i3] -> [i1;i2;i3] | _ -> - failwith ("strange type1, maybe because of weird order: "^ - (String.concat " " (List.map fst iis))) in + error (List.map snd iis) + ("strange type1, maybe because of weird order: "^ + (String.concat " " (List.map fst iis))) in (signed,base_res) | B.SizeType, ["size_t",i1] -> None, [i1] | B.SSizeType, ["ssize_t",i1] -> None, [i1] | B.PtrDiffType, ["ptrdiff_t",i1] -> None, [i1] - | _ -> failwith ("strange type2, maybe because of weird order: "^ - (String.concat " " (List.map fst iis))) + | _ -> + error (List.map snd iis) + ("strange type2, maybe because of weird order: "^ + (String.concat " " (List.map fst iis))) (*---------------------------------------------------------------------------*) @@ -445,8 +470,8 @@ let resplit_initialiser ibs iicomma = | [], [] -> [] | [], _ -> failwith "should have a iicomma, do you generate fakeInfo in parser?" - | _, [] -> - failwith "shouldn't have a iicomma" + | iicommas, [] -> + error iicommas "shouldn't have a iicomma" | [iicomma], x::xs -> let elems = List.map fst (x::xs) in let commas = List.map snd (x::xs) +> List.flatten in @@ -503,12 +528,14 @@ let one_initialisation_to_affectation x = match var with | Some (name, iniopt) -> (match iniopt with - | Some (iini, (B.InitExpr e, ii_empty2)) -> + | B.ValInit (iini, (B.InitExpr e, ii_empty2)) -> let local = 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 @@ -518,7 +545,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 @@ -526,11 +553,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 @@ -669,7 +697,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 @@ -716,11 +746,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) @@ -745,7 +776,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) @@ -768,14 +799,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. @@ -797,7 +837,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 -> @@ -807,7 +847,7 @@ let list_matcher match_dots rebuild_dots match_comma rebuild_comma ))) ) ) fail) - + | None,_ -> None) +++ (match match_comma ea, ebs with @@ -853,7 +893,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 @@ -863,8 +903,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 @@ -1007,6 +1046,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. @@ -1110,9 +1155,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 @@ -1127,6 +1169,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 -> @@ -1214,17 +1267,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] @@ -1318,18 +1373,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") @@ -1340,6 +1394,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 _, _ @@ -1359,12 +1424,14 @@ 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 | _, (((B.Cast (_, _)|B.ParenExpr _|B.SizeOfType _|B.SizeOfExpr _| + B.Constructor (_, _)| B.RecordPtAccess (_, _)| B.RecordAccess (_, _)|B.ArrayAccess (_, _)| B.Binary (_, _, _)|B.Unary (_, _)| @@ -1397,7 +1464,7 @@ and (ident_cpp: info_ident -> (A.ident, B.name) matcher) = fail and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) = - fun infoidb ida ((idb, iib)) -> (* (idb, iib) as ib *) + fun infoidb ida ((idb, iib) as ib) -> (* (idb, iib) as ib *) let check_constraints constraints idb = let meta_id_val l x = Ast_c.MetaIdVal(x,l) in match constraints with @@ -1477,9 +1544,13 @@ and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) = | DontKnow -> failwith "MetaLocalFunc, need more semantic info about id" ) + (* not clear why disj things are needed, after disjdistr? *) + | A.DisjId ias -> + ias +> List.fold_left (fun acc ia -> acc >|+|> (ident infoidb ia ib)) fail + | 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) = @@ -1497,12 +1568,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 @@ -1599,7 +1670,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 @@ -1619,7 +1690,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 @@ -1628,8 +1699,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 -> @@ -1644,7 +1715,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 -> @@ -1656,7 +1727,7 @@ and parameter = fun parama paramb -> p_namei = Some (nameidb); p_type = typb} )) - + | None, None -> return ( A.Param (typa, None)+> A.rewrap parama, @@ -1679,7 +1750,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 @@ -1709,6 +1780,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)-> @@ -1718,7 +1800,7 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) ))) - | _, (B.DeclList (xs, iiptvirgb::iifakestart::iisto)) -> + | _, (B.DeclList (xs, ((iiptvirgb::iifakestart::iisto) as ii))) -> let indexify l = let rec loop n = function [] -> [] @@ -1744,9 +1826,10 @@ and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = )))) tin)) fail else - failwith "More that one variable in decl. Have to split to transform." + 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 +1852,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) -> @@ -1785,7 +1929,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> *) | A.TyDecl (tya0, ptvirga), - ({B.v_namei = Some (nameidb, None); + ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; @@ -1794,7 +1938,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 +1975,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), @@ -1849,7 +1994,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> return ( (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla, - (({B.v_namei = Some (nameidb, None); + (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; @@ -1867,7 +2012,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]) -> @@ -1878,7 +2023,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> return ( (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla, - (({B.v_namei = Some (nameidb, None); + (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; @@ -1910,7 +2055,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> (* could handle iso here but handled in standard.iso *) | A.UnInit (stoa, typa, ida, ptvirga), - ({B.v_namei = Some (nameidb, None); + ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = local; @@ -1924,7 +2069,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> (fun stoa (stob, iistob) -> return ( (A.UnInit (stoa, typa, ida, ptvirga)) +> A.rewrap decla, - (({B.v_namei = Some (nameidb, None); + (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = local; @@ -1935,7 +2080,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> ))))) | A.Init (stoa, typa, ida, eqa, inia, ptvirga), - ({B.v_namei = Some(nameidb, Some (iieqb, inib)); + ({B.v_namei = Some(nameidb, B.ValInit (iieqb, inib)); B.v_type = typb; B.v_storage = stob; B.v_local = local; @@ -1952,7 +2097,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> initialiser inia inib >>= (fun inia inib -> return ( (A.Init (stoa, typa, ida, eqa, inia, ptvirga)) +> A.rewrap decla, - (({B.v_namei = Some(nameidb, Some (iieqb, inib)); + (({B.v_namei = Some(nameidb, B.ValInit (iieqb, inib)); B.v_type = typb; B.v_storage = stob; B.v_local = local; @@ -1962,6 +2107,16 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> iiptvirgb,iistob) ))))))) + | A.Init (stoa, typa, ida, eqa, inia, ptvirga), + ({B.v_namei = Some(nameidb, B.ConstrInit _); + B.v_type = typb; + B.v_storage = stob; + B.v_local = local; + B.v_attr = attrs; + B.v_type_bis = typbbis; + },iivirg) + -> fail (* C++ constructor declaration not supported in SmPL *) + (* do iso-by-absence here ? allow typedecl and var ? *) | A.TyDecl (typa, ptvirga), ({B.v_namei = None; B.v_type = typb; @@ -1989,7 +2144,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> | A.Typedef (stoa, typa, ida, ptvirga), - ({B.v_namei = Some (nameidb, None); + ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = (B.StoTypedef,inline); B.v_local = local; @@ -2004,7 +2159,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> tokenf stoa iitypedef >>= (fun stoa iitypedef -> return (stoa, [iitypedef]) ) - | _ -> failwith "weird, have both typedef and inline or nothing"; + | _ -> error iistob "weird, have both typedef and inline or nothing"; ) >>= (fun stoa iistob -> (match A.unwrap ida with | A.MetaType(_,_,_) -> @@ -2042,7 +2197,7 @@ and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> ) >>= (fun ida nameidb -> return ( (A.Typedef (stoa, typa, ida, ptvirga)) +> A.rewrap decla, - (({B.v_namei = Some (nameidb, None); + (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = (B.StoTypedef,inline); B.v_local = local; @@ -2101,6 +2256,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 -> @@ -2256,7 +2418,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, @@ -2272,6 +2435,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) @@ -2290,16 +2454,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 -> @@ -2348,9 +2516,17 @@ and (struct_fields: (A.declaration list, B.field list) matcher) = let build_dots (mcode, optexpr) = A.Ddots(mcode, optexpr) in let match_comma ea = None in let build_comma ia1 = failwith "not possible" 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.MetaFieldList(ida,leninfo,keep,inherited) -> + Some(ida,leninfo,keep,inherited) + | _ -> None in + let build_metalist (ida,leninfo,keep,inherited) = + A.MetaFieldList(ida,leninfo,keep,inherited) in + let mktermval v = + (* drop empty ii information, because nothing between elements *) + let v = List.map Ast_c.unwrap v in + Ast_c.MetaFieldListVal v in let special_cases ea eas ebs = None in let no_ii x = failwith "not possible" in let make_ebs ebs = List.map (function x -> Left x) ebs in @@ -2389,7 +2565,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) -> @@ -2398,7 +2574,7 @@ and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> let iisto = [] in let stob = B.NoSto, false in let fake_var = - ({B.v_namei = Some (nameidb, None); + ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = Ast_c.NotLocalDecl; @@ -2413,7 +2589,7 @@ and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> (fun fa (var,iiptvirgb,iisto) -> match fake_var with - | ({B.v_namei = Some (nameidb, None); + | ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; }, iivirg) -> @@ -2490,7 +2666,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 @@ -2509,11 +2685,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 () @@ -2536,7 +2716,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) ))) @@ -2544,7 +2724,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) ))) @@ -2552,6 +2732,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 @@ -2593,7 +2780,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). *) @@ -2657,8 +2844,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] -> @@ -2672,8 +2859,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] -> @@ -2684,16 +2890,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 @@ -2709,11 +2910,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) @@ -2865,7 +3066,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 -> @@ -2904,7 +3105,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = match ii with [iisub; lbb; rbb] -> (Common.Left iisub,lbb,rbb) | [iisub; iisb; lbb; rbb] -> (Common.Right (iisub,iisb),lbb,rbb) - | _ -> failwith "list of length 3 or 4 expected" in + | _ -> error ii "list of length 3 or 4 expected" in let process_type = match (sbopt,ii_sub_sb) with @@ -2913,7 +3114,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 @@ -2923,7 +3124,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]))) @@ -2985,6 +3186,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = ) + | _, (B.NoType, ii) -> fail | _, (B.TypeOfExpr e, ii) -> fail | _, (B.TypeOfType e, ii) -> fail @@ -3007,7 +3209,7 @@ and (typeC: (A.typeC, Ast_c.typeC) matcher) = (Common.Left iisub,lbb,rbb,comma_opt) | [iisub; iisb; lbb; rbb; comma_opt] -> (Common.Right (iisub,iisb),lbb,rbb,comma_opt) - | _ -> failwith "list of length 4 or 5 expected" in + | _ -> error ii "list of length 4 or 5 expected" in let process_type = match (sbopt,ii_sub_sb) with @@ -3016,12 +3218,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) @@ -3138,7 +3341,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 -> @@ -3183,7 +3386,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 -> @@ -3233,9 +3436,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 @@ -3274,6 +3476,8 @@ and compatible_type a (b,local) = let ok = return ((),()) in let rec loop = function + | _, (qua, (B.NoType, _)) -> + failwith "compatible_type: matching with NoType" | Type_cocci.BaseType a, (qua, (B.BaseType b,ii)) -> compatible_base_type a None b @@ -3292,7 +3496,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) @@ -3768,11 +3972,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 -> @@ -3796,16 +3995,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 @@ -3974,6 +4182,15 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = ))) else fail + | A.Undef(undefa,ida), F.DefineHeader ((idb, ii), B.Undef) -> + let (defineb, iidb, ieol) = tuple_of_list3 ii in + ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> + tokenf undefa defineb >>= (fun undefa defineb -> + return ( + A.Undef(undefa,ida), + F.DefineHeader ((idb,[defineb;iidb;ieol]),B.Undef) + )) + ) | A.DefineHeader(definea,ida,params), F.DefineHeader ((idb, ii), defkind) -> @@ -4060,6 +4277,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() @@ -4073,7 +4291,8 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = (F.Label (_, _, _)|F.Break (_, _)|F.Continue (_, _)|F.Default (_, _)| F.Case (_, _)|F.Include _|F.Goto _|F.ExprStatement _| F.DefineType _|F.DefineExpr _|F.DefineTodo| - F.DefineHeader (_, _)|F.ReturnExpr (_, _)|F.Return (_, _)|F.MacroIterHeader (_, _)| + F.DefineHeader (_, _)|F.ReturnExpr (_, _)|F.Return (_, _)| + F.MacroIterHeader (_, _)| F.SwitchHeader (_, _)|F.ForHeader (_, _)|F.DoWhileTail _|F.DoHeader (_, _)| F.WhileHeader (_, _)|F.Else _|F.IfHeader (_, _)| F.SeqEnd (_, _)|F.SeqStart (_, _, _)| @@ -4083,4 +4302,3 @@ let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = ) end -