parsing_cocci/check_meta.ml

   1 (*
   2 * Copyright 2005-2008, 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.Pointer(ty)
 179   | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
 180   | Type_cocci.MetaType(nm,_,_) -> Some nm
 181   | _ -> None
 182
 183 (* --------------------------------------------------------------------- *)
 184 (* Types *)
 185
 186 and typeC old_metas table minus t =
 187   match Ast0.unwrap t with
 188     Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
 189   | Ast0.Pointer(ty,star) -> typeC old_metas table minus ty
 190   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 191       typeC old_metas table minus ty;
 192       parameter_list old_metas table minus params
 193   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 194       get_opt (typeC old_metas table minus) ty;
 195       parameter_list old_metas table minus params
 196   | Ast0.Array(ty,lb,size,rb) ->
 197       typeC old_metas table minus ty;
 198       get_opt (expression ID old_metas table minus) size
 199   | Ast0.MetaType(name,_) ->
 200       check_table table minus name
 201   | Ast0.DisjType(_,types,_,_) ->
 202       List.iter (typeC old_metas table minus) types
 203   | Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
 204   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 205       typeC old_metas table minus ty;
 206       dots (declaration GLOBAL old_metas table minus) decls
 207   | Ast0.OptType(ty) | Ast0.UniqueType(ty) ->
 208       failwith "unexpected code"
 209   | _ -> () (* no metavariable subterms *)
 210
 211 (* --------------------------------------------------------------------- *)
 212 (* Variable declaration *)
 213 (* Even if the Cocci program specifies a list of declarations, they are
 214    split out into multiple declarations of a single variable each. *)
 215
 216 and declaration context old_metas table minus d =
 217   match Ast0.unwrap d with
 218     Ast0.Init(stg,ty,id,eq,ini,sem) ->
 219       (match Ast0.unwrap ini with
 220         Ast0.InitExpr exp ->
 221           typeC old_metas table minus ty;
 222           ident context old_metas table minus id;
 223           expression ID old_metas table minus exp
 224       | _ ->
 225           (*
 226           if minus
 227           then
 228             failwith "complex initializer specification not allowed in - code"
 229           else*)
 230             (typeC old_metas table minus ty;
 231              ident context old_metas table minus id;
 232              initialiser old_metas table minus ini))
 233   | Ast0.UnInit(stg,ty,id,sem) ->
 234       typeC old_metas table minus ty; ident context old_metas table minus id
 235   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 236       ident ID old_metas table minus name;
 237       dots (expression ID old_metas table minus) args
 238   | Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
 239   | Ast0.Typedef(stg,ty,id,sem) ->
 240       typeC old_metas table minus ty;
 241       typeC old_metas table minus id
 242   | Ast0.DisjDecl(_,decls,_,_) ->
 243       List.iter (declaration ID old_metas table minus) decls
 244   | Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x
 245   | Ast0.Ddots(_,None) -> ()
 246   | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
 247       failwith "unexpected code"
 248
 249 (* --------------------------------------------------------------------- *)
 250 (* Initialiser *)
 251
 252 and initialiser old_metas table minus ini =
 253   match Ast0.unwrap ini with
 254     Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
 255   | Ast0.InitList(lb,initlist,rb) ->
 256       dots (initialiser old_metas table minus) initlist
 257   | Ast0.InitGccDotName(dot,name,eq,ini) ->
 258       ident FIELD old_metas table minus name;
 259       initialiser old_metas table minus ini
 260   | Ast0.InitGccName(name,eq,ini) ->
 261       ident FIELD old_metas table minus name;
 262       initialiser old_metas table minus ini
 263   | Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
 264       expression ID old_metas table minus exp;
 265       initialiser old_metas table minus ini
 266   | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
 267       expression ID old_metas table minus exp1;
 268       expression ID old_metas table minus exp2;
 269       initialiser old_metas table minus ini
 270   | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
 271   | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
 272       failwith "unexpected code"
 273   | _ -> () (* no metavariable subterms *)
 274
 275 and initialiser_list old_metas table minus =
 276   dots (initialiser old_metas table minus)
 277
 278 (* --------------------------------------------------------------------- *)
 279 (* Parameter *)
 280
 281 and parameterTypeDef old_metas table minus param =
 282   match Ast0.unwrap param with
 283     Ast0.Param(ty,id) ->
 284       get_opt (ident ID old_metas table minus) id;
 285       typeC old_metas table minus ty
 286   | Ast0.MetaParam(name,_) ->
 287       check_table table minus name
 288   | Ast0.MetaParamList(name,None,_) ->
 289       check_table table minus name
 290   | Ast0.MetaParamList(name,Some lenname,_) ->
 291       check_table table minus name;
 292       check_table table minus lenname
 293   | _ -> () (* no metavariable subterms *)
 294
 295 and parameter_list old_metas table minus =
 296   dots (parameterTypeDef old_metas table minus)
 297
 298 (* --------------------------------------------------------------------- *)
 299 (* Top-level code *)
 300
 301 and statement old_metas table minus s =
 302   match Ast0.unwrap s with
 303     Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
 304   | Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
 305   | Ast0.ExprStatement(exp,sem) -> expression ID old_metas table minus exp
 306   | Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
 307       expression ID old_metas table minus exp;
 308       statement old_metas table minus branch
 309   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
 310       expression ID old_metas table minus exp;
 311       statement old_metas table minus branch1;
 312       statement old_metas table minus branch2
 313   | Ast0.While(wh,lp,exp,rp,body,_) ->
 314       expression ID old_metas table minus exp;
 315       statement old_metas table minus body
 316   | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 317       statement old_metas table minus body;
 318       expression ID old_metas table minus exp
 319   | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
 320       get_opt (expression ID old_metas table minus) exp1;
 321       get_opt (expression ID old_metas table minus) exp2;
 322       get_opt (expression ID old_metas table minus) exp3;
 323       statement old_metas table minus body
 324   | Ast0.Iterator(nm,lp,args,rp,body,_) ->
 325       ident ID old_metas table minus nm;
 326       dots (expression ID old_metas table minus) args;
 327       statement old_metas table minus body
 328   | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 329       expression ID old_metas table minus exp;
 330       dots (case_line old_metas table minus) cases
 331   | Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
 332   | Ast0.MetaStmt(name,_) ->     check_table table minus name
 333   | Ast0.MetaStmtList(name,_) -> check_table table minus name
 334   | Ast0.Exp(exp) -> expression ID old_metas table minus exp
 335   | Ast0.TopExp(exp) -> expression ID old_metas table minus exp
 336   | Ast0.Ty(ty) -> typeC old_metas table minus ty
 337   | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 338       List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
 339   | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
 340       dots (statement old_metas table minus) rule_elem_dots;
 341       List.iter (whencode (dots (statement old_metas table minus))
 342                    (statement old_metas table minus))
 343         w
 344   | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
 345       List.iter
 346         (whencode (dots (statement old_metas table minus))
 347            (statement old_metas table minus)) x
 348   | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 349       ident FN old_metas table minus name;
 350       List.iter (fninfo old_metas table minus) fi;
 351       parameter_list old_metas table minus params;
 352       dots (statement old_metas table minus) body
 353   | Ast0.Include(inc,s) -> () (* no metavariables possible *)
 354   | Ast0.Define(def,id,_,body) ->
 355       ident GLOBAL old_metas table minus id;
 356       dots (statement old_metas table minus) body
 357   | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
 358   | _ -> () (* no metavariable subterms *)
 359
 360 and fninfo old_metas table minus = function
 361     Ast0.FStorage(stg) -> ()
 362   | Ast0.FType(ty) -> typeC old_metas table minus ty
 363   | Ast0.FInline(inline) -> ()
 364   | Ast0.FAttr(attr) -> ()
 365
 366 and whencode notfn alwaysfn = function
 367     Ast0.WhenNot a -> notfn a
 368   | Ast0.WhenAlways a -> alwaysfn a
 369   | Ast0.WhenModifier(_) -> ()
 370
 371 and case_line old_metas table minus c =
 372   match Ast0.unwrap c with
 373     Ast0.Default(def,colon,code) ->
 374       dots (statement old_metas table minus) code
 375   | Ast0.Case(case,exp,colon,code) ->
 376       dots (statement old_metas table minus) code
 377   | Ast0.OptCase(case) -> failwith "unexpected code"
 378
 379 (* --------------------------------------------------------------------- *)
 380 (* Rules *)
 381
 382 let top_level old_metas table minus t =
 383   match Ast0.unwrap t with
 384     Ast0.DECL(stmt) -> statement old_metas table minus stmt
 385   | Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
 386   | Ast0.ERRORWORDS(exps) ->
 387       List.iter (expression FN old_metas table minus) exps
 388   | _ -> () (* no metavariables possible *)
 389
 390 let rule old_metas table minus rules =
 391   List.iter (top_level old_metas table minus) rules
 392
 393 (* --------------------------------------------------------------------- *)
 394
 395 let positions table rules =
 396   let mcode x =
 397     match Ast0.get_pos x with
 398       Ast0.MetaPos(name,constraints,_) ->
 399         let pos = Ast0.unwrap_mcode name in
 400         (find_loop table pos) := true
 401     | _ -> () in
 402   let option_default = () in
 403   let bind x y = () in
 404   let donothing r k e = k e in
 405   let fn =
 406     V0.combiner bind option_default
 407       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 408       mcode
 409       donothing donothing donothing donothing donothing donothing
 410       donothing donothing donothing donothing donothing donothing donothing
 411       donothing donothing in
 412
 413   List.iter fn.V0.combiner_top_level rules
 414
 415 let dup_positions rules =
 416   let mcode x =
 417     match Ast0.get_pos x with
 418       Ast0.MetaPos(name,constraints,_) ->
 419         let pos = Ast0.unwrap_mcode name in [pos]
 420     | _ -> [] in
 421   let option_default = [] in
 422   let bind x y = x@y in
 423
 424   (* Case for everything that has a disj.
 425      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 426      these. *)
 427
 428   let expression r k e =
 429     match Ast0.unwrap e with
 430       Ast0.DisjExpr(_,explist,_,_) ->
 431         List.fold_left Common.union_set option_default
 432           (List.map r.V0.combiner_expression explist)
 433     | _ -> k e in
 434
 435   let typeC r k e = (* not sure relevent because "only after iso" *)
 436     match Ast0.unwrap e with
 437       Ast0.DisjType(_,types,_,_) ->
 438         List.fold_left Common.union_set option_default
 439           (List.map r.V0.combiner_typeC types)
 440     | _ -> k e in
 441
 442   let declaration r k e =
 443     match Ast0.unwrap e with
 444       Ast0.DisjDecl(_,decls,_,_) ->
 445         List.fold_left Common.union_set option_default
 446           (List.map r.V0.combiner_declaration decls)
 447     | _ -> k e in
 448
 449   let statement r k e =
 450     match Ast0.unwrap e with
 451       Ast0.Disj(_,stmts,_,_) ->
 452         List.fold_left Common.union_set option_default
 453           (List.map r.V0.combiner_statement_dots stmts)
 454     | _ -> k e in
 455
 456   let donothing r k e = k e in
 457   let fn =
 458     V0.combiner bind option_default
 459       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 460       mcode
 461       donothing donothing donothing donothing donothing donothing
 462       donothing expression typeC donothing donothing declaration statement
 463       donothing donothing in
 464
 465   let res =
 466     List.sort compare
 467       (List.fold_left Common.union_set option_default
 468          (List.map fn.V0.combiner_top_level rules)) in
 469   let rec loop = function
 470       [] | [_] -> ()
 471     | ((rule,name) as x)::y::_ when x = y ->
 472         failwith (Printf.sprintf "duplicate use of %s.%s" rule name)
 473     | _::xs -> loop xs in
 474   loop res
 475
 476 (* --------------------------------------------------------------------- *)
 477
 478 let make_table l =
 479   let table =
 480     (Hashtbl.create(List.length l) :
 481        ((string * string), bool ref) Hashtbl.t) in
 482   List.iter
 483     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 484   table
 485
 486 let add_to_fresh_table l =
 487   List.iter
 488     (function x ->
 489       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 490     l
 491
 492 let check_all_marked rname err table after_err =
 493   Hashtbl.iter
 494     (function name ->
 495       function (cell) ->
 496         if not (!cell)
 497         then
 498           let (_,name) = name in
 499           warning
 500             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 501     table
 502
 503 let check_meta rname old_metas inherited_metavars metavars minus plus =
 504   let old_metas =
 505     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 506   let (fresh,other) =
 507     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 508       metavars in
 509   let (err,other) =
 510     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 511       other in
 512   let (ierr,iother) =
 513     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 514       inherited_metavars in
 515   let fresh_table = make_table fresh in
 516   let err_table = make_table (err@ierr) in
 517   let other_table = make_table other in
 518   let iother_table = make_table iother in
 519   add_to_fresh_table fresh;
 520   rule old_metas [iother_table;other_table;err_table] true minus;
 521   positions [iother_table;other_table] minus;
 522   dup_positions minus;
 523   check_all_marked rname "metavariable" other_table "in the - or context code";
 524   rule old_metas [iother_table;fresh_table;err_table] false plus;
 525   check_all_marked rname "fresh identifier metavariable" iother_table
 526     "in the -, +, or context code";
 527   check_all_marked rname "metavariable" fresh_table "in the + code";
 528   check_all_marked rname "error metavariable" err_table ""