parsing_cocci/.#check_meta.ml.1.80

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