(*
+ * 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.
*)
+# 0 "./check_meta.ml"
(* For minus fragment, checks that all of the identifier metavariables that
are used are not declared as fresh, and check that all declared variables
are used. For plus fragment, just check that the variables declared as
module VT0 = Visitor_ast0_types
(* all fresh identifiers *)
-let fresh_table = (Hashtbl.create(50) : ((string * string), unit) Hashtbl.t)
+let fresh_table = (Hashtbl.create(50) : (Ast.meta_name, unit) Hashtbl.t)
let warning s = Printf.fprintf stderr "warning: %s\n" s
let is_ifdef name =
String.length name > 2 && String.uppercase name = name
-let ident context old_metas table minus i =
+let rec ident context old_metas table minus i =
match Ast0.unwrap i with
- Ast0.Id((name,_,info,_,_,_) : string Ast0.mcode) ->
- let rl = info.Ast0.pos_info.Ast0.line_start in
- let is_plus i =
- match Ast0.get_mcodekind i with Ast0.PLUS _ -> true | _ -> false in
- let err =
- if List.exists (function x -> x = name) old_metas
+ Ast0.Id((name,_,info,_,_,_) : string Ast0.mcode) ->
+ let rl = info.Ast0.pos_info.Ast0.line_start in
+ let is_plus i =
+ match Ast0.get_mcodekind i with Ast0.PLUS _ -> true | _ -> false in
+ let err =
+ if List.exists (function x -> x = name) old_metas
&& (minus || is_plus i)
+ then
+ begin
+ warning
+ (Printf.sprintf
+ "line %d: %s, previously declared as a metavariable, is used as an identifier" rl name);
+ true
+ end
+ else false in
+ (match context with
+ ID ->
+ if not (is_ifdef name) && minus && not err(* warn only once per id *) && not info.Ast0.isSymbolIdent
then
- begin
- warning
- (Printf.sprintf
- "line %d: %s, previously declared as a metavariable, is used as an identifier" rl name);
- true
- end
- else false in
- (match context with
- ID ->
- if not (is_ifdef name) && minus && not err(* warn only once per id *)
- then
- warning
- (Printf.sprintf "line %d: should %s be a metavariable?" rl name)
- | _ -> ())
- | Ast0.MetaId(name,_,_) -> check_table table minus name
- | Ast0.MetaFunc(name,_,_) -> check_table table minus name
- | Ast0.MetaLocalFunc(name,_,_) -> check_table table minus name
- | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
- failwith "unexpected code"
+ warning
+ (Printf.sprintf "line %d: should %s be a metavariable?" rl name)
+ | _ -> ())
+ | Ast0.MetaId(name,_,seedval,_) ->
+ check_table table minus name;
+ seed table minus seedval
+ | Ast0.MetaFunc(name,_,_) -> check_table table minus name
+ | Ast0.MetaLocalFunc(name,_,_) -> check_table table minus name
+ | Ast0.AsIdent(id,asid) -> failwith "not generated yet"
+ | Ast0.DisjId(_,id_list,_,_) ->
+ List.iter (ident context old_metas table minus) id_list
+ | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
+ failwith "unexpected code"
+
+and seed table minus = function
+ Ast.NoVal -> ()
+ | Ast.StringSeed _ -> ()
+ | Ast.ListSeed elems ->
+ List.iter
+ (function
+ Ast.SeedString _ -> ()
+ | Ast.SeedId name -> check_table table minus (promote name))
+ elems
(* --------------------------------------------------------------------- *)
(* Expression *)
| Ast0.Assignment(left,op,right,_) ->
expression context old_metas table minus left;
expression ID old_metas table minus right
+ | Ast0.Sequence(left,op,right) ->
+ expression context old_metas table minus left;
+ expression ID old_metas table minus right
| Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
expression ID old_metas table minus exp1;
get_opt (expression ID old_metas table minus) exp2;
| Ast0.SizeOfExpr(szf,exp) -> expression ID old_metas table minus exp
| Ast0.SizeOfType(szf,lp,ty,rp) -> typeC old_metas table minus ty
| Ast0.TypeExp(ty) -> typeC old_metas table minus ty
+ | Ast0.Constructor(lp,ty,rp,init) ->
+ typeC old_metas table minus ty; initialiser old_metas table minus init
| Ast0.MetaExpr(name,_,Some tys,_,_) ->
List.iter
(function x ->
check_table table minus name
| Ast0.MetaExpr(name,_,_,_,_) | Ast0.MetaErr(name,_,_) ->
check_table table minus name
- | Ast0.MetaExprList(name,None,_) ->
- check_table table minus name
- | Ast0.MetaExprList(name,Some lenname,_) ->
+ | Ast0.MetaExprList(name,Ast0.MetaListLen lenname,_) ->
check_table table minus name;
check_table table minus lenname
+ | Ast0.MetaExprList(name,_,_) ->
+ check_table table minus name
+ | Ast0.AsExpr(exp,asexp) -> failwith "not generated yet"
| Ast0.DisjExpr(_,exps,_,_) ->
List.iter (expression context old_metas table minus) exps
| Ast0.NestExpr(_,exp_dots,_,w,_) ->
Type_cocci.ConstVol(_,ty) | Type_cocci.SignedT(_,Some ty)
| Type_cocci.Pointer(ty)
| Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
+ | Type_cocci.EnumName(Type_cocci.MV(nm,_,_)) -> Some nm
+ | Type_cocci.StructUnionName(_,Type_cocci.MV(nm,_,_)) -> Some nm
| Type_cocci.MetaType(nm,_,_) -> Some nm
| _ -> None
get_opt (expression ID old_metas table minus) size
| Ast0.MetaType(name,_) ->
check_table table minus name
+ | Ast0.AsType(ty,asty) -> failwith "not generated yet"
| Ast0.DisjType(_,types,_,_) ->
List.iter (typeC old_metas table minus) types
- | Ast0.EnumName(en,id) -> ident GLOBAL old_metas table minus id
+ | Ast0.EnumName(en,Some id) -> ident GLOBAL old_metas table minus id
+ | Ast0.EnumDef(ty,lb,ids,rb) ->
+ typeC old_metas table minus ty;
+ dots (expression GLOBAL old_metas table minus) ids
| Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
| Ast0.StructUnionDef(ty,lb,decls,rb) ->
typeC old_metas table minus ty;
and declaration context old_metas table minus d =
match Ast0.unwrap d with
- Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) ->
+ check_table table minus name
+ | Ast0.MetaFieldList(name,Ast0.MetaListLen lenname,_) ->
+ check_table table minus name;
+ check_table table minus lenname
+ | Ast0.MetaFieldList(name,_,_) ->
+ check_table table minus name
+ | Ast0.AsDecl(decl,asdecl) -> failwith "not generated yet"
+ | Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ typeC old_metas table minus ty;
+ ident context old_metas table minus id;
(match Ast0.unwrap ini with
Ast0.InitExpr exp ->
- typeC old_metas table minus ty;
- ident context old_metas table minus id;
expression ID old_metas table minus exp
| _ ->
(*
then
failwith "complex initializer specification not allowed in - code"
else*)
- (typeC old_metas table minus ty;
- ident context old_metas table minus id;
- initialiser old_metas table minus ini))
+ initialiser old_metas table minus ini)
| Ast0.UnInit(stg,ty,id,sem) ->
typeC old_metas table minus ty; ident context old_metas table minus id
| Ast0.MacroDecl(name,lp,args,rp,sem) ->
ident GLOBAL old_metas table minus name;
dots (expression ID old_metas table minus) args
+ | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ ident GLOBAL old_metas table minus name;
+ dots (expression ID old_metas table minus) args;
+ (match Ast0.unwrap ini with
+ Ast0.InitExpr exp -> expression ID old_metas table minus exp
+ | _ -> initialiser old_metas table minus ini)
| Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
| Ast0.Typedef(stg,ty,id,sem) ->
typeC old_metas table minus ty;
match Ast0.unwrap ini with
Ast0.MetaInit(name,_) ->
check_table table minus name
+ | Ast0.MetaInitList(name,Ast0.MetaListLen lenname,_) ->
+ check_table table minus name;
+ check_table table minus lenname
+ | Ast0.MetaInitList(name,_,_) ->
+ check_table table minus name
+ | Ast0.AsInit(ini,asini) -> failwith "not generated yet"
| Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
- | Ast0.InitList(lb,initlist,rb) ->
+ | Ast0.InitList(lb,initlist,rb,ordered) ->
dots (initialiser old_metas table minus) initlist
| Ast0.InitGccExt(designators,eq,ini) ->
List.iter (designator old_metas table minus) designators;
typeC old_metas table minus ty
| Ast0.MetaParam(name,_) ->
check_table table minus name
- | Ast0.MetaParamList(name,None,_) ->
- check_table table minus name
- | Ast0.MetaParamList(name,Some lenname,_) ->
+ | Ast0.MetaParamList(name,Ast0.MetaListLen lenname,_) ->
check_table table minus name;
check_table table minus lenname
+ | Ast0.MetaParamList(name,_,_) ->
+ check_table table minus name
| _ -> () (* no metavariable subterms *)
and parameter_list old_metas table minus =
match Ast0.unwrap s with
Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
| Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
- | Ast0.ExprStatement(exp,sem) -> expression ID old_metas table minus exp
+ | Ast0.ExprStatement(exp,sem) ->
+ get_opt (expression ID old_metas table minus) exp
| Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
expression ID old_metas table minus exp;
statement old_metas table minus branch
| Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
| Ast0.MetaStmt(name,_) -> check_table table minus name
| Ast0.MetaStmtList(name,_) -> check_table table minus name
+ | Ast0.AsStmt(stm,asstm) -> failwith "not generated yet"
| Ast0.Exp(exp) -> expression ID old_metas table minus exp
| Ast0.TopExp(exp) -> expression ID old_metas table minus exp
| Ast0.Ty(ty) -> typeC old_metas table minus ty
parameter_list old_metas table minus params;
dots (statement old_metas table minus) body
| Ast0.Include(inc,s) -> () (* no metavariables possible *)
- | Ast0.Define(def,id,_,body) ->
+ | Ast0.Undef(def,id) ->
+ ident GLOBAL old_metas table minus id
+ | Ast0.Define(def,id,params,body) ->
ident GLOBAL old_metas table minus id;
+ define_parameters old_metas table minus params;
dots (statement old_metas table minus) body
| Ast0.Label(i,_) -> ident ID old_metas table minus i
| Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
| _ -> () (* no metavariable subterms *)
+and define_param old_metas table minus p =
+ match Ast0.unwrap p with
+ Ast0.DParam(id) -> ident GLOBAL old_metas table minus id
+ | Ast0.DPComma(_) | Ast0.DPdots(_) | Ast0.DPcircles(_) ->
+ () (* no metavariable subterms *)
+ | Ast0.OptDParam(dp) -> define_param old_metas table minus dp
+ | Ast0.UniqueDParam(dp) -> define_param old_metas table minus dp
+
+and define_parameters old_metas table minus x =
+ match Ast0.unwrap x with
+ Ast0.NoParams -> ()
+ | Ast0.DParams(lp,dp,rp) -> dots (define_param old_metas table minus) dp
+
and fninfo old_metas table minus = function
Ast0.FStorage(stg) -> ()
| Ast0.FType(ty) -> typeC old_metas table minus ty
Ast0.Default(def,colon,code) ->
dots (statement old_metas table minus) code
| Ast0.Case(case,exp,colon,code) ->
+ expression GLOBAL old_metas table minus exp;
dots (statement old_metas table minus) code
| Ast0.DisjCase(_,case_lines,_,_) ->
List.iter (case_line old_metas table minus) case_lines
let top_level old_metas table minus t =
match Ast0.unwrap t with
- Ast0.DECL(stmt) -> statement old_metas table minus stmt
- | Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
+ Ast0.NONDECL(stmt) -> statement old_metas table minus stmt
+ | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) ->
+ dots (statement old_metas table minus) stmt_dots
| Ast0.ERRORWORDS(exps) ->
List.iter (expression FN old_metas table minus) exps
| _ -> () (* no metavariables possible *)
(* --------------------------------------------------------------------- *)
let positions table rules =
- let mcode x =
- match Ast0.get_pos x with
- Ast0.MetaPos(name,constraints,_) ->
- let pos = Ast0.unwrap_mcode name in
- (find_loop table pos) := true
- | _ -> () in
+ let rec rmcode x = (* needed for type inference, nonpolymorphic *)
+ List.iter
+ (function var ->
+ let name = Ast0.meta_pos_name var in
+ (find_loop table (Ast0.unwrap_mcode name)) := true;
+ rmcode name)
+ (Ast0.get_pos x) in
+ let rec mcode x =
+ List.iter
+ (function var ->
+ let name = Ast0.meta_pos_name var in
+ (find_loop table (Ast0.unwrap_mcode name)) := true;
+ rmcode name)
+ (Ast0.get_pos x) in
let option_default = () in
let bind x y = () in
let donothing r k e = k e in
let dup_positions rules =
let mcode x =
- match Ast0.get_pos x with
- Ast0.MetaPos(name,constraints,_) ->
- let pos = Ast0.unwrap_mcode name in [pos]
- | _ -> [] in
+ List.concat
+ (List.map
+ (function
+ Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,_)) ->
+ [Ast0.unwrap_mcode name]
+ | _ -> [])
+ (Ast0.get_pos x)) in
let option_default = [] in
let bind x y = x@y in
let rec loop = function
[] | [_] -> ()
| ((rule,name) as x)::y::_ when x = y ->
- failwith (Printf.sprintf "duplicate use of %s.%s" rule name)
+ failwith
+ (Printf.sprintf "duplicate use of %s.%s" rule name)
| _::xs -> loop xs in
loop res
let make_table l =
let table =
(Hashtbl.create(List.length l) :
- ((string * string), bool ref) Hashtbl.t) in
+ (Ast.meta_name, bool ref) Hashtbl.t) in
List.iter
(function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
table