+++ /dev/null
-(*
-* Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
-
-
-(* 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
-fresh are used. What is the issue about error variables? (don't remember) *)
-
-module Ast0 = Ast0_cocci
-module Ast = Ast_cocci
-module V0 = Visitor_ast0
-
-(* all fresh identifiers *)
-let fresh_table = (Hashtbl.create(50) : ((string * string), unit) Hashtbl.t)
-
-let warning s = Printf.fprintf stderr "warning: %s\n" s
-
-let promote name = (name,(),Ast0.default_info(),(),None)
-
-(* --------------------------------------------------------------------- *)
-
-let find_loop table name =
- let rec loop = function
- [] -> raise Not_found
- | x::xs -> (try Hashtbl.find x name with Not_found -> loop xs) in
- loop table
-
-let check_table table minus (name,_,info,_,_) =
- let rl = info.Ast0.line_start in
- if minus
- then
- (try (find_loop table name) := true
- with
- Not_found ->
- (try
- Hashtbl.find fresh_table name;
- let (_,name) = name in
- failwith
- (Printf.sprintf
- "%d: unexpected use of a fresh identifier %s" rl name)
- with Not_found -> ()))
- else (try (find_loop table name) := true with Not_found -> ())
-
-let get_opt fn = Common.do_option fn
-
-(* --------------------------------------------------------------------- *)
-(* Dots *)
-
-let dots fn d =
- match Ast0.unwrap d with
- Ast0.DOTS(x) -> List.iter fn x
- | Ast0.CIRCLES(x) -> List.iter fn x
- | Ast0.STARS(x) -> List.iter fn x
-
-(* --------------------------------------------------------------------- *)
-(* Identifier *)
-
-type context = ID | FIELD | FN | GLOBAL
-
-(* heuristic for distinguishing ifdef variables from undeclared metavariables*)
-let is_ifdef name =
- String.length name > 2 && String.uppercase name = name
-
-let ident context old_metas table minus i =
- match Ast0.unwrap i with
- Ast0.Id((name,_,info,_,_) : string Ast0.mcode) ->
- let rl = info.Ast0.line_start in
- let err =
- if List.exists (function x -> x = name) old_metas
- && (minus || Ast0.get_mcodekind i = Ast0.PLUS)
- 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"
-
-(* --------------------------------------------------------------------- *)
-(* Expression *)
-
-let rec expression context old_metas table minus e =
- match Ast0.unwrap e with
- Ast0.Ident(id) ->
- ident context old_metas table minus id
- | Ast0.FunCall(fn,lp,args,rp) ->
- expression FN old_metas table minus fn;
- dots (expression ID old_metas table minus) args
- | Ast0.Assignment(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;
- expression ID old_metas table minus exp3
- | Ast0.Postfix(exp,op) ->
- expression ID old_metas table minus exp
- | Ast0.Infix(exp,op) ->
- expression ID old_metas table minus exp
- | Ast0.Unary(exp,op) ->
- expression ID old_metas table minus exp
- | Ast0.Binary(left,op,right) ->
- expression ID old_metas table minus left;
- expression ID old_metas table minus right
- | Ast0.Paren(lp,exp,rp) ->
- expression ID old_metas table minus exp
- | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
- expression ID old_metas table minus exp1;
- expression ID old_metas table minus exp2
- | Ast0.RecordAccess(exp,pt,field) ->
- expression ID old_metas table minus exp;
- ident FIELD old_metas table minus field
- | Ast0.RecordPtAccess(exp,ar,field) ->
- expression ID old_metas table minus exp;
- ident FIELD old_metas table minus field
- | Ast0.Cast(lp,ty,rp,exp) ->
- typeC old_metas table minus ty; expression ID old_metas table minus exp
- | 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.MetaExpr(name,_,Some tys,_,_) ->
- List.iter
- (function x ->
- match get_type_name x with
- Some(ty) -> check_table table minus (promote ty)
- | None -> ())
- tys;
- 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,_) ->
- check_table table minus name;
- check_table table minus lenname
- | Ast0.DisjExpr(_,exps,_,_) ->
- List.iter (expression ID old_metas table minus) exps
- | Ast0.NestExpr(_,exp_dots,_,w,_) ->
- dots (expression ID old_metas table minus) exp_dots;
- get_opt (expression ID old_metas table minus) w
- | Ast0.Edots(_,Some x) | Ast0.Ecircles(_,Some x) | Ast0.Estars(_,Some x) ->
- expression ID old_metas table minus x
- | _ -> () (* no metavariable subterms *)
-
-and get_type_name = function
- Type_cocci.ConstVol(_,ty) | Type_cocci.Pointer(ty)
- | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
- | Type_cocci.MetaType(nm,_,_) -> Some nm
- | _ -> None
-
-(* --------------------------------------------------------------------- *)
-(* Types *)
-
-and typeC old_metas table minus t =
- match Ast0.unwrap t with
- Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
- | Ast0.Pointer(ty,star) -> typeC old_metas table minus ty
- | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
- typeC old_metas table minus ty;
- parameter_list old_metas table minus params
- | Ast0.FunctionType(ty,lp1,params,rp1) ->
- get_opt (typeC old_metas table minus) ty;
- parameter_list old_metas table minus params
- | Ast0.Array(ty,lb,size,rb) ->
- typeC old_metas table minus ty;
- get_opt (expression ID old_metas table minus) size
- | Ast0.MetaType(name,_) ->
- check_table table minus name
- | Ast0.DisjType(_,types,_,_) ->
- List.iter (typeC old_metas table minus) types
- | Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
- | Ast0.StructUnionDef(ty,lb,decls,rb) ->
- typeC old_metas table minus ty;
- dots (declaration GLOBAL old_metas table minus) decls
- | Ast0.OptType(ty) | Ast0.UniqueType(ty) ->
- failwith "unexpected code"
- | _ -> () (* no metavariable subterms *)
-
-(* --------------------------------------------------------------------- *)
-(* Variable declaration *)
-(* Even if the Cocci program specifies a list of declarations, they are
- split out into multiple declarations of a single variable each. *)
-
-and declaration context old_metas table minus d =
- match Ast0.unwrap d with
- Ast0.Init(stg,ty,id,eq,ini,sem) ->
- (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
- | _ ->
- (*
- if minus
- 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))
- | 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 ID old_metas table minus name;
- dots (expression ID old_metas table minus) args
- | Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
- | Ast0.Typedef(stg,ty,id,sem) ->
- typeC old_metas table minus ty;
- typeC old_metas table minus id
- | Ast0.DisjDecl(_,decls,_,_) ->
- List.iter (declaration ID old_metas table minus) decls
- | Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x
- | Ast0.Ddots(_,None) -> ()
- | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
- failwith "unexpected code"
-
-(* --------------------------------------------------------------------- *)
-(* Initialiser *)
-
-and initialiser old_metas table minus ini =
- match Ast0.unwrap ini with
- Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
- | Ast0.InitList(lb,initlist,rb) ->
- dots (initialiser old_metas table minus) initlist
- | Ast0.InitGccDotName(dot,name,eq,ini) ->
- ident FIELD old_metas table minus name;
- initialiser old_metas table minus ini
- | Ast0.InitGccName(name,eq,ini) ->
- ident FIELD old_metas table minus name;
- initialiser old_metas table minus ini
- | Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
- expression ID old_metas table minus exp;
- initialiser old_metas table minus ini
- | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
- expression ID old_metas table minus exp1;
- expression ID old_metas table minus exp2;
- initialiser old_metas table minus ini
- | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
- | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
- failwith "unexpected code"
- | _ -> () (* no metavariable subterms *)
-
-and initialiser_list old_metas table minus =
- dots (initialiser old_metas table minus)
-
-(* --------------------------------------------------------------------- *)
-(* Parameter *)
-
-and parameterTypeDef old_metas table minus param =
- match Ast0.unwrap param with
- Ast0.Param(ty,id) ->
- get_opt (ident ID old_metas table minus) id;
- 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,_) ->
- check_table table minus name;
- check_table table minus lenname
- | _ -> () (* no metavariable subterms *)
-
-and parameter_list old_metas table minus =
- dots (parameterTypeDef old_metas table minus)
-
-(* --------------------------------------------------------------------- *)
-(* Top-level code *)
-
-and statement old_metas table minus s =
- 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.IfThen(iff,lp,exp,rp,branch,_) ->
- expression ID old_metas table minus exp;
- statement old_metas table minus branch
- | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
- expression ID old_metas table minus exp;
- statement old_metas table minus branch1;
- statement old_metas table minus branch2
- | Ast0.While(wh,lp,exp,rp,body,_) ->
- expression ID old_metas table minus exp;
- statement old_metas table minus body
- | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
- statement old_metas table minus body;
- expression ID old_metas table minus exp
- | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
- get_opt (expression ID old_metas table minus) exp1;
- get_opt (expression ID old_metas table minus) exp2;
- get_opt (expression ID old_metas table minus) exp3;
- statement old_metas table minus body
- | Ast0.Iterator(nm,lp,args,rp,body,_) ->
- ident ID old_metas table minus nm;
- dots (expression ID old_metas table minus) args;
- statement old_metas table minus body
- | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
- expression ID old_metas table minus exp;
- dots (case_line old_metas table minus) cases
- | 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.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
- | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
- List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
- | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
- dots (statement old_metas table minus) rule_elem_dots;
- List.iter (whencode (dots (statement old_metas table minus))
- (statement old_metas table minus))
- w
- | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
- List.iter
- (whencode (dots (statement old_metas table minus))
- (statement old_metas table minus)) x
- | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
- ident FN old_metas table minus name;
- List.iter (fninfo old_metas table minus) fi;
- 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) ->
- ident GLOBAL old_metas table minus id;
- dots (statement old_metas table minus) body
- | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
- | _ -> () (* no metavariable subterms *)
-
-and fninfo old_metas table minus = function
- Ast0.FStorage(stg) -> ()
- | Ast0.FType(ty) -> typeC old_metas table minus ty
- | Ast0.FInline(inline) -> ()
- | Ast0.FAttr(attr) -> ()
-
-and whencode notfn alwaysfn = function
- Ast0.WhenNot a -> notfn a
- | Ast0.WhenAlways a -> alwaysfn a
- | Ast0.WhenModifier(_) -> ()
-
-and case_line old_metas table minus c =
- match Ast0.unwrap c with
- Ast0.Default(def,colon,code) ->
- dots (statement old_metas table minus) code
- | Ast0.Case(case,exp,colon,code) ->
- dots (statement old_metas table minus) code
- | Ast0.OptCase(case) -> failwith "unexpected code"
-
-(* --------------------------------------------------------------------- *)
-(* Rules *)
-
-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.ERRORWORDS(exps) ->
- List.iter (expression FN old_metas table minus) exps
- | _ -> () (* no metavariables possible *)
-
-let rule old_metas table minus rules =
- List.iter (top_level old_metas table minus) rules
-
-(* --------------------------------------------------------------------- *)
-
-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 option_default = () in
- let bind x y = () in
- let donothing r k e = k e in
- let fn =
- V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
- donothing donothing donothing donothing donothing donothing
- donothing donothing donothing donothing donothing donothing donothing
- donothing donothing in
-
- List.iter fn.V0.combiner_top_level rules
-
-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
- let option_default = [] in
- let bind x y = x@y in
-
- (* Case for everything that has a disj.
- Note, no positions on ( | ) of a disjunction, so no need to recurse on
- these. *)
-
- let expression r k e =
- match Ast0.unwrap e with
- Ast0.DisjExpr(_,explist,_,_) ->
- List.fold_left Common.union_set option_default
- (List.map r.V0.combiner_expression explist)
- | _ -> k e in
-
- let typeC r k e = (* not sure relevent because "only after iso" *)
- match Ast0.unwrap e with
- Ast0.DisjType(_,types,_,_) ->
- List.fold_left Common.union_set option_default
- (List.map r.V0.combiner_typeC types)
- | _ -> k e in
-
- let declaration r k e =
- match Ast0.unwrap e with
- Ast0.DisjDecl(_,decls,_,_) ->
- List.fold_left Common.union_set option_default
- (List.map r.V0.combiner_declaration decls)
- | _ -> k e in
-
- let statement r k e =
- match Ast0.unwrap e with
- Ast0.Disj(_,stmts,_,_) ->
- List.fold_left Common.union_set option_default
- (List.map r.V0.combiner_statement_dots stmts)
- | _ -> k e in
-
- let donothing r k e = k e in
- let fn =
- V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
- donothing donothing donothing donothing donothing donothing
- donothing expression typeC donothing donothing declaration statement
- donothing donothing in
-
- let res =
- List.sort compare
- (List.fold_left Common.union_set option_default
- (List.map fn.V0.combiner_top_level rules)) in
- let rec loop = function
- [] | [_] -> ()
- | ((rule,name) as x)::y::_ when x = y ->
- 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
- List.iter
- (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
- table
-
-let add_to_fresh_table l =
- List.iter
- (function x ->
- let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
- l
-
-let check_all_marked rname err table after_err =
- Hashtbl.iter
- (function name ->
- function (cell) ->
- if not (!cell)
- then
- let (_,name) = name in
- warning
- (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
- table
-
-let check_meta rname old_metas inherited_metavars metavars minus plus =
- let old_metas =
- List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
- let (fresh,other) =
- List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
- metavars in
- let (err,other) =
- List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
- other in
- let (ierr,iother) =
- List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
- inherited_metavars in
- let fresh_table = make_table fresh in
- let err_table = make_table (err@ierr) in
- let other_table = make_table other in
- let iother_table = make_table iother in
- add_to_fresh_table fresh;
- rule old_metas [iother_table;other_table;err_table] true minus;
- positions [iother_table;other_table] minus;
- dup_positions minus;
- check_all_marked rname "metavariable" other_table "in the - or context code";
- rule old_metas [iother_table;fresh_table;err_table] false plus;
- check_all_marked rname "fresh identifier metavariable" iother_table
- "in the -, +, or context code";
- check_all_marked rname "metavariable" fresh_table "in the + code";
- check_all_marked rname "error metavariable" err_table ""
HCoop / bpt / coccinelle.git / blobdiff