[bpt/coccinelle.git] / parsing_cocci / .#check_meta.ml.1.86

(*
* Copyright 2005-2009, 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.SignedT(_,Some 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.Signed(sgn,ty) ->
      get_opt (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.EnumName(en,id) -> ident GLOBAL old_metas table minus id
  | 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 GLOBAL 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 GLOBAL 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.TopInit(init) -> initialiser old_metas table minus init
  | 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)
		   (expression ID 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)
	   (expression ID 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 expression = function
    Ast0.WhenNot a -> notfn a
  | Ast0.WhenAlways a -> alwaysfn a
  | Ast0.WhenModifier(_) -> ()
  | Ast0.WhenNotTrue a -> expression a
  | Ast0.WhenNotFalse a -> expression a

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
      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
      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 "inherited 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 ""
Commit	Line	Data
113803cf C	1	(*
	2	* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
	3	* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
	4	* This file is part of Coccinelle.
	5	*
	6	* Coccinelle is free software: you can redistribute it and/or modify
	7	* it under the terms of the GNU General Public License as published by
	8	* the Free Software Foundation, according to version 2 of the License.
	9	*
	10	* Coccinelle is distributed in the hope that it will be useful,
	11	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	* GNU General Public License for more details.
	14	*
	15	* You should have received a copy of the GNU General Public License
	16	* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
	17	*
	18	* The authors reserve the right to distribute this or future versions of
	19	* Coccinelle under other licenses.
	20	*)
	21
	22
	23	(* For minus fragment, checks that all of the identifier metavariables that
	24	are used are not declared as fresh, and check that all declared variables
	25	are used. For plus fragment, just check that the variables declared as
	26	fresh are used. What is the issue about error variables? (don't remember) *)
	27
	28	module Ast0 = Ast0_cocci
	29	module Ast = Ast_cocci
	30	module V0 = Visitor_ast0
	31
	32	(* all fresh identifiers *)
	33	let fresh_table = (Hashtbl.create(50) : ((string * string), unit) Hashtbl.t)
	34
	35	let warning s = Printf.fprintf stderr "warning: %s\n" s
	36
	37	let promote name = (name,(),Ast0.default_info(),(),None)
	38
	39	(* --------------------------------------------------------------------- *)
	40
	41	let find_loop table name =
	42	let rec loop = function
	43	[] -> raise Not_found
	44	\| x::xs -> (try Hashtbl.find x name with Not_found -> loop xs) in
	45	loop table
	46
	47	let check_table table minus (name,_,info,_,_) =
	48	let rl = info.Ast0.line_start in
	49	if minus
	50	then
	51	(try (find_loop table name) := true
	52	with
	53	Not_found ->
	54	(try
	55	Hashtbl.find fresh_table name;
	56	let (_,name) = name in
	57	failwith
	58	(Printf.sprintf
	59	"%d: unexpected use of a fresh identifier %s" rl name)
	60	with Not_found -> ()))
	61	else (try (find_loop table name) := true with Not_found -> ())
	62
	63	let get_opt fn = Common.do_option fn
	64
65	(* --------------------------------------------------------------------- *)
66	(* Dots *)
67
68	let dots fn d =
69	match Ast0.unwrap d with
70	Ast0.DOTS(x) -> List.iter fn x
71	\| Ast0.CIRCLES(x) -> List.iter fn x
72	\| Ast0.STARS(x) -> List.iter fn x
73
74	(* --------------------------------------------------------------------- *)
75	(* Identifier *)
76
77	type context = ID \| FIELD \| FN \| GLOBAL
78
79	(* heuristic for distinguishing ifdef variables from undeclared metavariables*)
80	let is_ifdef name =
81	String.length name > 2 && String.uppercase name = name
82
83	let ident context old_metas table minus i =
84	match Ast0.unwrap i with
85	Ast0.Id((name,_,info,_,_) : string Ast0.mcode) ->
86	let rl = info.Ast0.line_start in
87	let err =
88	if List.exists (function x -> x = name) old_metas
89	&& (minus \|\| Ast0.get_mcodekind i = Ast0.PLUS)
90	then
91	begin
92	warning
93	(Printf.sprintf
94	"line %d: %s, previously declared as a metavariable, is used as an identifier" rl name);
95	true
96	end
97	else false in
98	(match context with
99	ID ->
100	if not (is_ifdef name) && minus && not err(* warn only once per id *)
101	then
102	warning
103	(Printf.sprintf "line %d: should %s be a metavariable?" rl name)
104	\| _ -> ())
105	\| Ast0.MetaId(name,_,_) -> check_table table minus name
106	\| Ast0.MetaFunc(name,_,_) -> check_table table minus name
107	\| Ast0.MetaLocalFunc(name,_,_) -> check_table table minus name
108	\| Ast0.OptIdent(_) \| Ast0.UniqueIdent(_) ->
109	failwith "unexpected code"
110
111	(* --------------------------------------------------------------------- *)
112	(* Expression *)
113
114	let rec expression context old_metas table minus e =
115	match Ast0.unwrap e with
116	Ast0.Ident(id) ->
117	ident context old_metas table minus id
118	\| Ast0.FunCall(fn,lp,args,rp) ->
119	expression FN old_metas table minus fn;
120	dots (expression ID old_metas table minus) args
121	\| Ast0.Assignment(left,op,right,_) ->
122	expression context old_metas table minus left;
123	expression ID old_metas table minus right
124	\| Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
125	expression ID old_metas table minus exp1;
126	get_opt (expression ID old_metas table minus) exp2;
127	expression ID old_metas table minus exp3
128	\| Ast0.Postfix(exp,op) ->
129	expression ID old_metas table minus exp
130	\| Ast0.Infix(exp,op) ->
131	expression ID old_metas table minus exp
132	\| Ast0.Unary(exp,op) ->
133	expression ID old_metas table minus exp
134	\| Ast0.Binary(left,op,right) ->
135	expression ID old_metas table minus left;
136	expression ID old_metas table minus right
137	\| Ast0.Paren(lp,exp,rp) ->
138	expression ID old_metas table minus exp
139	\| Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
140	expression ID old_metas table minus exp1;
141	expression ID old_metas table minus exp2
142	\| Ast0.RecordAccess(exp,pt,field) ->
143	expression ID old_metas table minus exp;
144	ident FIELD old_metas table minus field
145	\| Ast0.RecordPtAccess(exp,ar,field) ->
146	expression ID old_metas table minus exp;
147	ident FIELD old_metas table minus field
148	\| Ast0.Cast(lp,ty,rp,exp) ->
149	typeC old_metas table minus ty; expression ID old_metas table minus exp
150	\| Ast0.SizeOfExpr(szf,exp) -> expression ID old_metas table minus exp
151	\| Ast0.SizeOfType(szf,lp,ty,rp) -> typeC old_metas table minus ty
152	\| Ast0.TypeExp(ty) -> typeC old_metas table minus ty
153	\| Ast0.MetaExpr(name,_,Some tys,_,_) ->
154	List.iter
155	(function x ->
156	match get_type_name x with
157	Some(ty) -> check_table table minus (promote ty)
158	\| None -> ())
159	tys;
160	check_table table minus name
161	\| Ast0.MetaExpr(name,_,_,_,_) \| Ast0.MetaErr(name,_,_) ->
162	check_table table minus name
163	\| Ast0.MetaExprList(name,None,_) ->
164	check_table table minus name
165	\| Ast0.MetaExprList(name,Some lenname,_) ->
166	check_table table minus name;
167	check_table table minus lenname
168	\| Ast0.DisjExpr(_,exps,_,_) ->
169	List.iter (expression ID old_metas table minus) exps
170	\| Ast0.NestExpr(_,exp_dots,_,w,_) ->
171	dots (expression ID old_metas table minus) exp_dots;
172	get_opt (expression ID old_metas table minus) w
173	\| Ast0.Edots(_,Some x) \| Ast0.Ecircles(_,Some x) \| Ast0.Estars(_,Some x) ->
174	expression ID old_metas table minus x
175	\| _ -> () (* no metavariable subterms *)
176
177	and get_type_name = function
178	Type_cocci.ConstVol(_,ty) \| Type_cocci.SignedT(_,Some ty)
179	\| Type_cocci.Pointer(ty)
180	\| Type_cocci.FunctionPointer(ty) \| Type_cocci.Array(ty) -> get_type_name ty
181	\| Type_cocci.MetaType(nm,_,_) -> Some nm
182	\| _ -> None
183
184	(* --------------------------------------------------------------------- *)
185	(* Types *)
186
187	and typeC old_metas table minus t =
188	match Ast0.unwrap t with
189	Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
190	\| Ast0.Signed(sgn,ty) ->
191	get_opt (typeC old_metas table minus) ty
192	\| Ast0.Pointer(ty,star) -> typeC old_metas table minus ty
193	\| Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
194	typeC old_metas table minus ty;
195	parameter_list old_metas table minus params
196	\| Ast0.FunctionType(ty,lp1,params,rp1) ->
197	get_opt (typeC old_metas table minus) ty;
198	parameter_list old_metas table minus params
199	\| Ast0.Array(ty,lb,size,rb) ->
200	typeC old_metas table minus ty;
201	get_opt (expression ID old_metas table minus) size
202	\| Ast0.MetaType(name,_) ->
203	check_table table minus name
204	\| Ast0.DisjType(_,types,_,_) ->
205	List.iter (typeC old_metas table minus) types
206	\| Ast0.EnumName(en,id) -> ident GLOBAL old_metas table minus id
207	\| Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
208	\| Ast0.StructUnionDef(ty,lb,decls,rb) ->
209	typeC old_metas table minus ty;
210	dots (declaration GLOBAL old_metas table minus) decls
211	\| Ast0.OptType(ty) \| Ast0.UniqueType(ty) ->
212	failwith "unexpected code"
213	\| _ -> () (* no metavariable subterms *)
214
215	(* --------------------------------------------------------------------- *)
216	(* Variable declaration *)
217	(* Even if the Cocci program specifies a list of declarations, they are
218	split out into multiple declarations of a single variable each. *)
219
220	and declaration context old_metas table minus d =
221	match Ast0.unwrap d with
222	Ast0.Init(stg,ty,id,eq,ini,sem) ->
223	(match Ast0.unwrap ini with
224	Ast0.InitExpr exp ->
225	typeC old_metas table minus ty;
226	ident context old_metas table minus id;
227	expression ID old_metas table minus exp
228	\| _ ->
229	(*
230	if minus
231	then
232	failwith "complex initializer specification not allowed in - code"
233	else*)
234	(typeC old_metas table minus ty;
235	ident context old_metas table minus id;
236	initialiser old_metas table minus ini))
237	\| Ast0.UnInit(stg,ty,id,sem) ->
238	typeC old_metas table minus ty; ident context old_metas table minus id
239	\| Ast0.MacroDecl(name,lp,args,rp,sem) ->
240	ident GLOBAL old_metas table minus name;
241	dots (expression ID old_metas table minus) args
242	\| Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
243	\| Ast0.Typedef(stg,ty,id,sem) ->
244	typeC old_metas table minus ty;
245	typeC old_metas table minus id
246	\| Ast0.DisjDecl(_,decls,_,_) ->
247	List.iter (declaration ID old_metas table minus) decls
248	\| Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x
249	\| Ast0.Ddots(_,None) -> ()
250	\| Ast0.OptDecl(_) \| Ast0.UniqueDecl(_) ->
251	failwith "unexpected code"
252
253	(* --------------------------------------------------------------------- *)
254	(* Initialiser *)
255
256	and initialiser old_metas table minus ini =
257	match Ast0.unwrap ini with
258	Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
259	\| Ast0.InitList(lb,initlist,rb) ->
260	dots (initialiser old_metas table minus) initlist
261	\| Ast0.InitGccDotName(dot,name,eq,ini) ->
262	ident FIELD old_metas table minus name;
263	initialiser old_metas table minus ini
264	\| Ast0.InitGccName(name,eq,ini) ->
265	ident FIELD old_metas table minus name;
266	initialiser old_metas table minus ini
267	\| Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
268	expression ID old_metas table minus exp;
269	initialiser old_metas table minus ini
270	\| Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
271	expression ID old_metas table minus exp1;
272	expression ID old_metas table minus exp2;
273	initialiser old_metas table minus ini
274	\| Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
275	\| Ast0.OptIni(_) \| Ast0.UniqueIni(_) ->
276	failwith "unexpected code"
277	\| _ -> () (* no metavariable subterms *)
278
279	and initialiser_list old_metas table minus =
280	dots (initialiser old_metas table minus)
281
282	(* --------------------------------------------------------------------- *)
283	(* Parameter *)
284
285	and parameterTypeDef old_metas table minus param =
286	match Ast0.unwrap param with
287	Ast0.Param(ty,id) ->
288	get_opt (ident ID old_metas table minus) id;
289	typeC old_metas table minus ty
290	\| Ast0.MetaParam(name,_) ->
291	check_table table minus name
292	\| Ast0.MetaParamList(name,None,_) ->
293	check_table table minus name
294	\| Ast0.MetaParamList(name,Some lenname,_) ->
295	check_table table minus name;
296	check_table table minus lenname
297	\| _ -> () (* no metavariable subterms *)
298
299	and parameter_list old_metas table minus =
300	dots (parameterTypeDef old_metas table minus)
301
302	(* --------------------------------------------------------------------- *)
303	(* Top-level code *)
304
305	and statement old_metas table minus s =
306	match Ast0.unwrap s with
307	Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
308	\| Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
309	\| Ast0.ExprStatement(exp,sem) -> expression ID old_metas table minus exp
310	\| Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
311	expression ID old_metas table minus exp;
312	statement old_metas table minus branch
313	\| Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
314	expression ID old_metas table minus exp;
315	statement old_metas table minus branch1;
316	statement old_metas table minus branch2
317	\| Ast0.While(wh,lp,exp,rp,body,_) ->
318	expression ID old_metas table minus exp;
319	statement old_metas table minus body
320	\| Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
321	statement old_metas table minus body;
322	expression ID old_metas table minus exp
323	\| Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
324	get_opt (expression ID old_metas table minus) exp1;
325	get_opt (expression ID old_metas table minus) exp2;
326	get_opt (expression ID old_metas table minus) exp3;
327	statement old_metas table minus body
328	\| Ast0.Iterator(nm,lp,args,rp,body,_) ->
329	ident GLOBAL old_metas table minus nm;
330	dots (expression ID old_metas table minus) args;
331	statement old_metas table minus body
332	\| Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
333	expression ID old_metas table minus exp;
334	dots (case_line old_metas table minus) cases
335	\| Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
336	\| Ast0.MetaStmt(name,_) -> check_table table minus name
337	\| Ast0.MetaStmtList(name,_) -> check_table table minus name
338	\| Ast0.Exp(exp) -> expression ID old_metas table minus exp
339	\| Ast0.TopExp(exp) -> expression ID old_metas table minus exp
340	\| Ast0.Ty(ty) -> typeC old_metas table minus ty
341	\| Ast0.TopInit(init) -> initialiser old_metas table minus init
342	\| Ast0.Disj(_,rule_elem_dots_list,_,_) ->
343	List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
344	\| Ast0.Nest(_,rule_elem_dots,_,w,_) ->
345	dots (statement old_metas table minus) rule_elem_dots;
346	List.iter (whencode (dots (statement old_metas table minus))
347	(statement old_metas table minus)
348	(expression ID old_metas table minus))
349	w
350	\| Ast0.Dots(_,x) \| Ast0.Circles(_,x) \| Ast0.Stars(_,x) ->
351	List.iter
352	(whencode (dots (statement old_metas table minus))
353	(statement old_metas table minus)
354	(expression ID old_metas table minus)) x
355	\| Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
356	ident FN old_metas table minus name;
357	List.iter (fninfo old_metas table minus) fi;
358	parameter_list old_metas table minus params;
359	dots (statement old_metas table minus) body
360	\| Ast0.Include(inc,s) -> () (* no metavariables possible *)
361	\| Ast0.Define(def,id,_,body) ->
362	ident GLOBAL old_metas table minus id;
363	dots (statement old_metas table minus) body
364	\| Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
365	\| _ -> () (* no metavariable subterms *)
366
367	and fninfo old_metas table minus = function
368	Ast0.FStorage(stg) -> ()
369	\| Ast0.FType(ty) -> typeC old_metas table minus ty
370	\| Ast0.FInline(inline) -> ()
371	\| Ast0.FAttr(attr) -> ()
372
373	and whencode notfn alwaysfn expression = function
374	Ast0.WhenNot a -> notfn a
375	\| Ast0.WhenAlways a -> alwaysfn a
376	\| Ast0.WhenModifier(_) -> ()
377	\| Ast0.WhenNotTrue a -> expression a
378	\| Ast0.WhenNotFalse a -> expression a
379
380	and case_line old_metas table minus c =
381	match Ast0.unwrap c with
382	Ast0.Default(def,colon,code) ->
383	dots (statement old_metas table minus) code
384	\| Ast0.Case(case,exp,colon,code) ->
385	dots (statement old_metas table minus) code
386	\| Ast0.OptCase(case) -> failwith "unexpected code"
387
388	(* --------------------------------------------------------------------- *)
389	(* Rules *)
390
391	let top_level old_metas table minus t =
392	match Ast0.unwrap t with
393	Ast0.DECL(stmt) -> statement old_metas table minus stmt
394	\| Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
395	\| Ast0.ERRORWORDS(exps) ->
396	List.iter (expression FN old_metas table minus) exps
397	\| _ -> () (* no metavariables possible *)
398
399	let rule old_metas table minus rules =
400	List.iter (top_level old_metas table minus) rules
401
402	(* --------------------------------------------------------------------- *)
403
404	let positions table rules =
405	let mcode x =
406	match Ast0.get_pos x with
407	Ast0.MetaPos(name,constraints,_) ->
408	let pos = Ast0.unwrap_mcode name in
409	(find_loop table pos) := true
410	\| _ -> () in
411	let option_default = () in
412	let bind x y = () in
413	let donothing r k e = k e in
414	let fn =
415	V0.combiner bind option_default
416	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
417	donothing donothing donothing donothing donothing donothing
418	donothing donothing donothing donothing donothing donothing donothing
419	donothing donothing in
420
421	List.iter fn.V0.combiner_top_level rules
422
423	let dup_positions rules =
424	let mcode x =
425	match Ast0.get_pos x with
426	Ast0.MetaPos(name,constraints,_) ->
427	let pos = Ast0.unwrap_mcode name in [pos]
428	\| _ -> [] in
429	let option_default = [] in
430	let bind x y = x@y in
431
432	(* Case for everything that has a disj.
433	Note, no positions on ( \| ) of a disjunction, so no need to recurse on
434	these. *)
435
436	let expression r k e =
437	match Ast0.unwrap e with
438	Ast0.DisjExpr(_,explist,_,_) ->
439	List.fold_left Common.union_set option_default
440	(List.map r.V0.combiner_expression explist)
441	\| _ -> k e in
442
443	let typeC r k e = (* not sure relevent because "only after iso" *)
444	match Ast0.unwrap e with
445	Ast0.DisjType(_,types,_,_) ->
446	List.fold_left Common.union_set option_default
447	(List.map r.V0.combiner_typeC types)
448	\| _ -> k e in
449
450	let declaration r k e =
451	match Ast0.unwrap e with
452	Ast0.DisjDecl(_,decls,_,_) ->
453	List.fold_left Common.union_set option_default
454	(List.map r.V0.combiner_declaration decls)
455	\| _ -> k e in
456
457	let statement r k e =
458	match Ast0.unwrap e with
459	Ast0.Disj(_,stmts,_,_) ->
460	List.fold_left Common.union_set option_default
461	(List.map r.V0.combiner_statement_dots stmts)
462	\| _ -> k e in
463
464	let donothing r k e = k e in
465	let fn =
466	V0.combiner bind option_default
467	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
468	donothing donothing donothing donothing donothing donothing
469	donothing expression typeC donothing donothing declaration statement
470	donothing donothing in
471
472	let res =
473	List.sort compare
474	(List.fold_left Common.union_set option_default
475	(List.map fn.V0.combiner_top_level rules)) in
476	let rec loop = function
477	[] \| [_] -> ()
478	\| ((rule,name) as x)::y::_ when x = y ->
479	failwith (Printf.sprintf "duplicate use of %s.%s" rule name)
480	\| _::xs -> loop xs in
481	loop res
482
483	(* --------------------------------------------------------------------- *)
484
485	let make_table l =
486	let table =
487	(Hashtbl.create(List.length l) :
488	((string * string), bool ref) Hashtbl.t) in
489	List.iter
490	(function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
491	table
492
493	let add_to_fresh_table l =
494	List.iter
495	(function x ->
496	let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
497	l
498
499	let check_all_marked rname err table after_err =
500	Hashtbl.iter
501	(function name ->
502	function (cell) ->
503	if not (!cell)
504	then
505	let (_,name) = name in
506	warning
507	(Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
508	table
509
510	let check_meta rname old_metas inherited_metavars metavars minus plus =
511	let old_metas =
512	List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
513	let (fresh,other) =
514	List.partition (function Ast.MetaFreshIdDecl(_,_) -> true \| _ -> false)
515	metavars in
516	let (err,other) =
517	List.partition (function Ast.MetaErrDecl(_,_) -> true \| _ -> false)
518	other in
519	let (ierr,iother) =
520	List.partition (function Ast.MetaErrDecl(_,_) -> true \| _ -> false)
521	inherited_metavars in
522	let fresh_table = make_table fresh in
523	let err_table = make_table (err@ierr) in
524	let other_table = make_table other in
525	let iother_table = make_table iother in
526	add_to_fresh_table fresh;
527	rule old_metas [iother_table;other_table;err_table] true minus;
528	positions [iother_table;other_table] minus;
529	dup_positions minus;
530	check_all_marked rname "metavariable" other_table "in the - or context code";
531	rule old_metas [iother_table;fresh_table;err_table] false plus;
532	check_all_marked rname "inherited metavariable" iother_table
533	"in the -, +, or context code";
534	check_all_marked rname "metavariable" fresh_table "in the + code";
535	check_all_marked rname "error metavariable" err_table ""