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.TopInit(init) -> initialiser old_metas table minus init
 338   | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 339       List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
 340   | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
 341       dots (statement old_metas table minus) rule_elem_dots;
 342       List.iter (whencode (dots (statement old_metas table minus))
 343                    (statement old_metas table minus)
 344                    (expression ID old_metas table minus))
 345         w
 346   | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
 347       List.iter
 348         (whencode (dots (statement old_metas table minus))
 349            (statement old_metas table minus)
 350            (expression ID old_metas table minus)) x
 351   | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 352       ident FN old_metas table minus name;
 353       List.iter (fninfo old_metas table minus) fi;
 354       parameter_list old_metas table minus params;
 355       dots (statement old_metas table minus) body
 356   | Ast0.Include(inc,s) -> () (* no metavariables possible *)
 357   | Ast0.Define(def,id,_,body) ->
 358       ident GLOBAL old_metas table minus id;
 359       dots (statement old_metas table minus) body
 360   | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
 361   | _ -> () (* no metavariable subterms *)
 362
 363 and fninfo old_metas table minus = function
 364     Ast0.FStorage(stg) -> ()
 365   | Ast0.FType(ty) -> typeC old_metas table minus ty
 366   | Ast0.FInline(inline) -> ()
 367   | Ast0.FAttr(attr) -> ()
 368
 369 and whencode notfn alwaysfn expression = function
 370     Ast0.WhenNot a -> notfn a
 371   | Ast0.WhenAlways a -> alwaysfn a
 372   | Ast0.WhenModifier(_) -> ()
 373   | Ast0.WhenNotTrue a -> expression a
 374   | Ast0.WhenNotFalse a -> expression a
 375
 376 and case_line old_metas table minus c =
 377   match Ast0.unwrap c with
 378     Ast0.Default(def,colon,code) ->
 379       dots (statement old_metas table minus) code
 380   | Ast0.Case(case,exp,colon,code) ->
 381       dots (statement old_metas table minus) code
 382   | Ast0.OptCase(case) -> failwith "unexpected code"
 383
 384 (* --------------------------------------------------------------------- *)
 385 (* Rules *)
 386
 387 let top_level old_metas table minus t =
 388   match Ast0.unwrap t with
 389     Ast0.DECL(stmt) -> statement old_metas table minus stmt
 390   | Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
 391   | Ast0.ERRORWORDS(exps) ->
 392       List.iter (expression FN old_metas table minus) exps
 393   | _ -> () (* no metavariables possible *)
 394
 395 let rule old_metas table minus rules =
 396   List.iter (top_level old_metas table minus) rules
 397
 398 (* --------------------------------------------------------------------- *)
 399
 400 let positions table rules =
 401   let mcode x =
 402     match Ast0.get_pos x with
 403       Ast0.MetaPos(name,constraints,_) ->
 404         let pos = Ast0.unwrap_mcode name in
 405         (find_loop table pos) := true
 406     | _ -> () in
 407   let option_default = () in
 408   let bind x y = () in
 409   let donothing r k e = k e in
 410   let fn =
 411     V0.combiner bind option_default
 412       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 413       mcode
 414       donothing donothing donothing donothing donothing donothing
 415       donothing donothing donothing donothing donothing donothing donothing
 416       donothing donothing in
 417
 418   List.iter fn.V0.combiner_top_level rules
 419
 420 let dup_positions rules =
 421   let mcode x =
 422     match Ast0.get_pos x with
 423       Ast0.MetaPos(name,constraints,_) ->
 424         let pos = Ast0.unwrap_mcode name in [pos]
 425     | _ -> [] in
 426   let option_default = [] in
 427   let bind x y = x@y in
 428
 429   (* Case for everything that has a disj.
 430      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 431      these. *)
 432
 433   let expression r k e =
 434     match Ast0.unwrap e with
 435       Ast0.DisjExpr(_,explist,_,_) ->
 436         List.fold_left Common.union_set option_default
 437           (List.map r.V0.combiner_expression explist)
 438     | _ -> k e in
 439
 440   let typeC r k e = (* not sure relevent because "only after iso" *)
 441     match Ast0.unwrap e with
 442       Ast0.DisjType(_,types,_,_) ->
 443         List.fold_left Common.union_set option_default
 444           (List.map r.V0.combiner_typeC types)
 445     | _ -> k e in
 446
 447   let declaration r k e =
 448     match Ast0.unwrap e with
 449       Ast0.DisjDecl(_,decls,_,_) ->
 450         List.fold_left Common.union_set option_default
 451           (List.map r.V0.combiner_declaration decls)
 452     | _ -> k e in
 453
 454   let statement r k e =
 455     match Ast0.unwrap e with
 456       Ast0.Disj(_,stmts,_,_) ->
 457         List.fold_left Common.union_set option_default
 458           (List.map r.V0.combiner_statement_dots stmts)
 459     | _ -> k e in
 460
 461   let donothing r k e = k e in
 462   let fn =
 463     V0.combiner bind option_default
 464       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 465       mcode
 466       donothing donothing donothing donothing donothing donothing
 467       donothing expression typeC donothing donothing declaration statement
 468       donothing donothing in
 469
 470   let res =
 471     List.sort compare
 472       (List.fold_left Common.union_set option_default
 473          (List.map fn.V0.combiner_top_level rules)) in
 474   let rec loop = function
 475       [] | [_] -> ()
 476     | ((rule,name) as x)::y::_ when x = y ->
 477         failwith (Printf.sprintf "duplicate use of %s.%s" rule name)
 478     | _::xs -> loop xs in
 479   loop res
 480
 481 (* --------------------------------------------------------------------- *)
 482
 483 let make_table l =
 484   let table =
 485     (Hashtbl.create(List.length l) :
 486        ((string * string), bool ref) Hashtbl.t) in
 487   List.iter
 488     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 489   table
 490
 491 let add_to_fresh_table l =
 492   List.iter
 493     (function x ->
 494       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 495     l
 496
 497 let check_all_marked rname err table after_err =
 498   Hashtbl.iter
 499     (function name ->
 500       function (cell) ->
 501         if not (!cell)
 502         then
 503           let (_,name) = name in
 504           warning
 505             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 506     table
 507
 508 let check_meta rname old_metas inherited_metavars metavars minus plus =
 509   let old_metas =
 510     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 511   let (fresh,other) =
 512     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 513       metavars in
 514   let (err,other) =
 515     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 516       other in
 517   let (ierr,iother) =
 518     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 519       inherited_metavars in
 520   let fresh_table = make_table fresh in
 521   let err_table = make_table (err@ierr) in
 522   let other_table = make_table other in
 523   let iother_table = make_table iother in
 524   add_to_fresh_table fresh;
 525   rule old_metas [iother_table;other_table;err_table] true minus;
 526   positions [iother_table;other_table] minus;
 527   dup_positions minus;
 528   check_all_marked rname "metavariable" other_table "in the - or context code";
 529   rule old_metas [iother_table;fresh_table;err_table] false plus;
 530   check_all_marked rname "fresh identifier metavariable" iother_table
 531     "in the -, +, or context code";
 532   check_all_marked rname "metavariable" fresh_table "in the + code";
 533   check_all_marked rname "error metavariable" err_table ""