(*
- * 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
*)
+# 0 "./cocci_vs_c.ml"
open Common
module A = Ast_cocci
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 *)
(*****************************************************************************)
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
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
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
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
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 _
), _
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
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 _
), _
| 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]
| 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)))
(*---------------------------------------------------------------------------*)
| [], [] -> []
| [], _ ->
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
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
| 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
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
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
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)
(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)
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.
(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 ->
)))
)
) fail)
-
+
| None,_ -> None)
+++
(match match_comma ea, ebs with
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
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
* 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.
((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
))))
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 ->
((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]
))))
| 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")
(* 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 _, _
(* 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 (_, _)|
| 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) =
* 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
let {B.p_register=(hasreg,iihasreg);
p_namei = idbopt;
p_type=tb; } = eb in
-
+
if idbopt =*= None && not hasreg
then
match tb with
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
| _, None, ii -> Right ii
| _ -> raise Impossible
*)
-
-
+
+
and parameter = fun parama paramb ->
match A.unwrap parama, paramb with
A.MetaParam (ida,keep,inherited), eb ->
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 ->
p_namei = Some (nameidb);
p_type = typb}
))
-
+
| None, None ->
return (
A.Param (typa, None)+> A.rewrap parama,
| 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
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)->
(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
[] -> []
)))) tin))
fail
else
- failwith "More that one variable in decl. Have to split to transform. Check that there is no transformation on the type or the ;"
+ 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 ->
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) ->
*)
| 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;
}, 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),
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),
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;
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]) ->
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;
(* 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;
(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;
)))))
| 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;
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;
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;
| 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;
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(_,_,_) ->
) >>= (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;
))
)
+ | 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 ->
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,
(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)
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 ->
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
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) ->
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;
(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) ->
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
(* "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 ()
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)
)))
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)
)))
)
)
+ | 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
(* 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).
*)
| [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] ->
)
+ | 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] ->
(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
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)
- (* 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 ->
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
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
(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])))
(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
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)
| 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 ->
| 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 ->
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
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)
| _ -> raise Impossible
)
-
-
-
-
-
| A.Decl (mckstart,allminus,decla), F.Decl declb ->
declaration (mckstart,allminus,decla) declb >>=
(fun (mckstart,allminus,decla) declb ->
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
(* todo?: print a warning at least ? *)
| _, F.CaseRange _
| _, F.Asm _
+ -> fail2()
| _, F.MacroTop _
-> fail2()
)
end
-
HCoop / bpt / coccinelle.git / blobdiff