parsing_cocci/.#check_meta.ml.1.88

   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.MetaInit(name,_) ->
 259       check_table table minus name
 260   | Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
 261   | Ast0.InitList(lb,initlist,rb) ->
 262       dots (initialiser old_metas table minus) initlist
 263   | Ast0.InitGccExt(designators,eq,ini) ->
 264       List.iter (designator old_metas table minus) designators;
 265       initialiser old_metas table minus ini
 266   | Ast0.InitGccName(name,eq,ini) ->
 267       ident FIELD old_metas table minus name;
 268       initialiser old_metas table minus ini
 269   | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
 270   | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
 271       failwith "unexpected code"
 272   | _ -> () (* no metavariable subterms *)
 273
 274 and designator old_metas table minus = function
 275     Ast0.DesignatorField(dot,id) ->
 276       ident FIELD old_metas table minus id
 277   | Ast0.DesignatorIndex(lb,exp,rb) ->
 278       expression ID old_metas table minus exp
 279   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 280       expression ID old_metas table minus min;
 281       expression ID old_metas table minus max
 282
 283 and initialiser_list old_metas table minus =
 284   dots (initialiser old_metas table minus)
 285
 286 (* --------------------------------------------------------------------- *)
 287 (* Parameter *)
 288
 289 and parameterTypeDef old_metas table minus param =
 290   match Ast0.unwrap param with
 291     Ast0.Param(ty,id) ->
 292       get_opt (ident ID old_metas table minus) id;
 293       typeC old_metas table minus ty
 294   | Ast0.MetaParam(name,_) ->
 295       check_table table minus name
 296   | Ast0.MetaParamList(name,None,_) ->
 297       check_table table minus name
 298   | Ast0.MetaParamList(name,Some lenname,_) ->
 299       check_table table minus name;
 300       check_table table minus lenname
 301   | _ -> () (* no metavariable subterms *)
 302
 303 and parameter_list old_metas table minus =
 304   dots (parameterTypeDef old_metas table minus)
 305
 306 (* --------------------------------------------------------------------- *)
 307 (* Top-level code *)
 308
 309 and statement old_metas table minus s =
 310   match Ast0.unwrap s with
 311     Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
 312   | Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
 313   | Ast0.ExprStatement(exp,sem) -> expression ID old_metas table minus exp
 314   | Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
 315       expression ID old_metas table minus exp;
 316       statement old_metas table minus branch
 317   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
 318       expression ID old_metas table minus exp;
 319       statement old_metas table minus branch1;
 320       statement old_metas table minus branch2
 321   | Ast0.While(wh,lp,exp,rp,body,_) ->
 322       expression ID old_metas table minus exp;
 323       statement old_metas table minus body
 324   | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 325       statement old_metas table minus body;
 326       expression ID old_metas table minus exp
 327   | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
 328       get_opt (expression ID old_metas table minus) exp1;
 329       get_opt (expression ID old_metas table minus) exp2;
 330       get_opt (expression ID old_metas table minus) exp3;
 331       statement old_metas table minus body
 332   | Ast0.Iterator(nm,lp,args,rp,body,_) ->
 333       ident GLOBAL old_metas table minus nm;
 334       dots (expression ID old_metas table minus) args;
 335       statement old_metas table minus body
 336   | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 337       expression ID old_metas table minus exp;
 338       dots (case_line old_metas table minus) cases
 339   | Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
 340   | Ast0.MetaStmt(name,_) ->     check_table table minus name
 341   | Ast0.MetaStmtList(name,_) -> check_table table minus name
 342   | Ast0.Exp(exp) -> expression ID old_metas table minus exp
 343   | Ast0.TopExp(exp) -> expression ID old_metas table minus exp
 344   | Ast0.Ty(ty) -> typeC old_metas table minus ty
 345   | Ast0.TopInit(init) -> initialiser old_metas table minus init
 346   | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 347       List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
 348   | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
 349       dots (statement old_metas table minus) rule_elem_dots;
 350       List.iter (whencode (dots (statement old_metas table minus))
 351                    (statement old_metas table minus)
 352                    (expression ID old_metas table minus))
 353         w
 354   | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
 355       List.iter
 356         (whencode (dots (statement old_metas table minus))
 357            (statement old_metas table minus)
 358            (expression ID old_metas table minus)) x
 359   | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 360       ident FN old_metas table minus name;
 361       List.iter (fninfo old_metas table minus) fi;
 362       parameter_list old_metas table minus params;
 363       dots (statement old_metas table minus) body
 364   | Ast0.Include(inc,s) -> () (* no metavariables possible *)
 365   | Ast0.Define(def,id,_,body) ->
 366       ident GLOBAL old_metas table minus id;
 367       dots (statement old_metas table minus) body
 368   | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
 369   | _ -> () (* no metavariable subterms *)
 370
 371 and fninfo old_metas table minus = function
 372     Ast0.FStorage(stg) -> ()
 373   | Ast0.FType(ty) -> typeC old_metas table minus ty
 374   | Ast0.FInline(inline) -> ()
 375   | Ast0.FAttr(attr) -> ()
 376
 377 and whencode notfn alwaysfn expression = function
 378     Ast0.WhenNot a -> notfn a
 379   | Ast0.WhenAlways a -> alwaysfn a
 380   | Ast0.WhenModifier(_) -> ()
 381   | Ast0.WhenNotTrue a -> expression a
 382   | Ast0.WhenNotFalse a -> expression a
 383
 384 and case_line old_metas table minus c =
 385   match Ast0.unwrap c with
 386     Ast0.Default(def,colon,code) ->
 387       dots (statement old_metas table minus) code
 388   | Ast0.Case(case,exp,colon,code) ->
 389       dots (statement old_metas table minus) code
 390   | Ast0.OptCase(case) -> failwith "unexpected code"
 391
 392 (* --------------------------------------------------------------------- *)
 393 (* Rules *)
 394
 395 let top_level old_metas table minus t =
 396   match Ast0.unwrap t with
 397     Ast0.DECL(stmt) -> statement old_metas table minus stmt
 398   | Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
 399   | Ast0.ERRORWORDS(exps) ->
 400       List.iter (expression FN old_metas table minus) exps
 401   | _ -> () (* no metavariables possible *)
 402
 403 let rule old_metas table minus rules =
 404   List.iter (top_level old_metas table minus) rules
 405
 406 (* --------------------------------------------------------------------- *)
 407
 408 let positions table rules =
 409   let mcode x =
 410     match Ast0.get_pos x with
 411       Ast0.MetaPos(name,constraints,_) ->
 412         let pos = Ast0.unwrap_mcode name in
 413         (find_loop table pos) := true
 414     | _ -> () in
 415   let option_default = () in
 416   let bind x y = () in
 417   let donothing r k e = k e in
 418   let fn =
 419     V0.combiner bind option_default
 420       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 421       donothing donothing donothing donothing donothing donothing
 422       donothing donothing donothing donothing donothing donothing donothing
 423       donothing donothing in
 424
 425   List.iter fn.V0.combiner_top_level rules
 426
 427 let dup_positions rules =
 428   let mcode x =
 429     match Ast0.get_pos x with
 430       Ast0.MetaPos(name,constraints,_) ->
 431         let pos = Ast0.unwrap_mcode name in [pos]
 432     | _ -> [] in
 433   let option_default = [] in
 434   let bind x y = x@y in
 435
 436   (* Case for everything that has a disj.
 437      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 438      these. *)
 439
 440   let expression r k e =
 441     match Ast0.unwrap e with
 442       Ast0.DisjExpr(_,explist,_,_) ->
 443         List.fold_left Common.union_set option_default
 444           (List.map r.V0.combiner_expression explist)
 445     | _ -> k e in
 446
 447   let typeC r k e = (* not sure relevent because "only after iso" *)
 448     match Ast0.unwrap e with
 449       Ast0.DisjType(_,types,_,_) ->
 450         List.fold_left Common.union_set option_default
 451           (List.map r.V0.combiner_typeC types)
 452     | _ -> k e in
 453
 454   let declaration r k e =
 455     match Ast0.unwrap e with
 456       Ast0.DisjDecl(_,decls,_,_) ->
 457         List.fold_left Common.union_set option_default
 458           (List.map r.V0.combiner_declaration decls)
 459     | _ -> k e in
 460
 461   let statement r k e =
 462     match Ast0.unwrap e with
 463       Ast0.Disj(_,stmts,_,_) ->
 464         List.fold_left Common.union_set option_default
 465           (List.map r.V0.combiner_statement_dots stmts)
 466     | _ -> k e in
 467
 468   let donothing r k e = k e in
 469   let fn =
 470     V0.combiner bind option_default
 471       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 472       donothing donothing donothing donothing donothing donothing
 473       donothing expression typeC donothing donothing declaration statement
 474       donothing donothing in
 475
 476   let res =
 477     List.sort compare
 478       (List.fold_left Common.union_set option_default
 479          (List.map fn.V0.combiner_top_level rules)) in
 480   let rec loop = function
 481       [] | [_] -> ()
 482     | ((rule,name) as x)::y::_ when x = y ->
 483         failwith (Printf.sprintf "duplicate use of %s.%s" rule name)
 484     | _::xs -> loop xs in
 485   loop res
 486
 487 (* --------------------------------------------------------------------- *)
 488
 489 let make_table l =
 490   let table =
 491     (Hashtbl.create(List.length l) :
 492        ((string * string), bool ref) Hashtbl.t) in
 493   List.iter
 494     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 495   table
 496
 497 let add_to_fresh_table l =
 498   List.iter
 499     (function x ->
 500       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 501     l
 502
 503 let check_all_marked rname err table after_err =
 504   Hashtbl.iter
 505     (function name ->
 506       function (cell) ->
 507         if not (!cell)
 508         then
 509           let (_,name) = name in
 510           warning
 511             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 512     table
 513
 514 let check_meta rname old_metas inherited_metavars metavars minus plus =
 515   let old_metas =
 516     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 517   let (fresh,other) =
 518     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 519       metavars in
 520   let (err,other) =
 521     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 522       other in
 523   let (ierr,iother) =
 524     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 525       inherited_metavars in
 526   let fresh_table = make_table fresh in
 527   let err_table = make_table (err@ierr) in
 528   let other_table = make_table other in
 529   let iother_table = make_table iother in
 530   add_to_fresh_table fresh;
 531   rule old_metas [iother_table;other_table;err_table] true minus;
 532   positions [iother_table;other_table] minus;
 533   dup_positions minus;
 534   check_all_marked rname "metavariable" other_table "in the - or context code";
 535   rule old_metas [iother_table;fresh_table;err_table] false plus;
 536   check_all_marked rname "inherited metavariable" iother_table
 537     "in the -, +, or context code";
 538   check_all_marked rname "metavariable" fresh_table "in the + code";
 539   check_all_marked rname "error metavariable" err_table ""