(*
- * 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
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
(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)
(* '...' 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 >||> (
* 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 ->
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)->
)))))))
| _ -> fail)
- | _, (B.MacroDecl _ |B.DeclList _) -> 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) ->
}, 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),
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]) ->
))
)
+ | 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)
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) ->
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).
*)
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 ->
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])))
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)
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 ->