2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
25 (* For minus fragment, checks that all of the identifier metavariables that
26 are used are not declared as fresh, and check that all declared variables
27 are used. For plus fragment, just check that the variables declared as
28 fresh are used. What is the issue about error variables? (don't remember) *)
30 module Ast0
= Ast0_cocci
31 module Ast
= Ast_cocci
32 module V0
= Visitor_ast0
33 module VT0
= Visitor_ast0_types
35 (* all fresh identifiers *)
36 let fresh_table = (Hashtbl.create
(50) : (Ast.meta_name
, unit) Hashtbl.t
)
38 let warning s
= Printf.fprintf stderr
"warning: %s\n" s
40 let promote name
= (name
,(),Ast0.default_info
(),(),None
,-1)
42 (* --------------------------------------------------------------------- *)
44 let find_loop table name
=
45 let rec loop = function
47 | x
::xs
-> (try Hashtbl.find x name
with Not_found
-> loop xs
) in
50 let check_table table minus
(name
,_
,info
,_
,_
,_
) =
51 let rl = info
.Ast0.pos_info
.Ast0.line_start
in
54 (try (find_loop table name
) := true
58 Hashtbl.find
fresh_table name
;
59 let (_
,name
) = name
in
62 "%d: unexpected use of a fresh identifier %s" rl name
)
63 with Not_found
-> ()))
64 else (try (find_loop table name
) := true with Not_found
-> ())
66 let get_opt fn
= Common.do_option fn
68 (* --------------------------------------------------------------------- *)
72 match Ast0.unwrap d
with
73 Ast0.DOTS
(x
) -> List.iter fn x
74 | Ast0.CIRCLES
(x
) -> List.iter fn x
75 | Ast0.STARS
(x
) -> List.iter fn x
77 (* --------------------------------------------------------------------- *)
80 type context
= ID
| FIELD
| FN
| GLOBAL
82 (* heuristic for distinguishing ifdef variables from undeclared metavariables*)
84 String.length name
> 2 && String.uppercase name
= name
86 let ident context old_metas table minus i
=
87 match Ast0.unwrap i
with
88 Ast0.Id
((name
,_
,info
,_
,_
,_
) : string Ast0.mcode
) ->
89 let rl = info
.Ast0.pos_info
.Ast0.line_start
in
91 match Ast0.get_mcodekind i
with Ast0.PLUS _
-> true | _
-> false in
93 if List.exists
(function x
-> x
= name
) old_metas
94 && (minus
|| is_plus i
)
99 "line %d: %s, previously declared as a metavariable, is used as an identifier" rl name
);
105 if not
(is_ifdef name
) && minus
&& not
err(* warn only once per id *)
108 (Printf.sprintf
"line %d: should %s be a metavariable?" rl name
)
110 | Ast0.MetaId
(name
,_
,_
) -> check_table table minus name
111 | Ast0.MetaFunc
(name
,_
,_
) -> check_table table minus name
112 | Ast0.MetaLocalFunc
(name
,_
,_
) -> check_table table minus name
113 | Ast0.OptIdent
(_
) | Ast0.UniqueIdent
(_
) ->
114 failwith
"unexpected code"
116 (* --------------------------------------------------------------------- *)
119 let rec expression context old_metas table minus e
=
120 match Ast0.unwrap e
with
122 ident context old_metas table minus id
123 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
124 expression FN old_metas table minus fn
;
125 dots (expression ID old_metas table minus
) args
126 | Ast0.Assignment
(left
,op
,right
,_
) ->
127 expression context old_metas table minus left
;
128 expression ID old_metas table minus right
129 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
130 expression ID old_metas table minus exp1
;
131 get_opt (expression ID old_metas table minus
) exp2
;
132 expression ID old_metas table minus exp3
133 | Ast0.Postfix
(exp
,op
) ->
134 expression ID old_metas table minus exp
135 | Ast0.Infix
(exp
,op
) ->
136 expression ID old_metas table minus exp
137 | Ast0.Unary
(exp
,op
) ->
138 expression ID old_metas table minus exp
139 | Ast0.Binary
(left
,op
,right
) ->
140 expression ID old_metas table minus left
;
141 expression ID old_metas table minus right
142 | Ast0.Paren
(lp
,exp
,rp
) ->
143 expression ID old_metas table minus exp
144 | Ast0.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
145 expression ID old_metas table minus exp1
;
146 expression ID old_metas table minus exp2
147 | Ast0.RecordAccess
(exp
,pt
,field
) ->
148 expression ID old_metas table minus exp
;
149 ident FIELD old_metas table minus field
150 | Ast0.RecordPtAccess
(exp
,ar
,field
) ->
151 expression ID old_metas table minus exp
;
152 ident FIELD old_metas table minus field
153 | Ast0.Cast
(lp
,ty
,rp
,exp
) ->
154 typeC old_metas table minus ty
; expression ID old_metas table minus exp
155 | Ast0.SizeOfExpr
(szf
,exp
) -> expression ID old_metas table minus exp
156 | Ast0.SizeOfType
(szf
,lp
,ty
,rp
) -> typeC old_metas table minus ty
157 | Ast0.TypeExp
(ty
) -> typeC old_metas table minus ty
158 | Ast0.MetaExpr
(name
,_
,Some tys
,_
,_
) ->
161 match get_type_name x
with
162 Some
(ty
) -> check_table table minus
(promote ty
)
165 check_table table minus name
166 | Ast0.MetaExpr
(name
,_
,_
,_
,_
) | Ast0.MetaErr
(name
,_
,_
) ->
167 check_table table minus name
168 | Ast0.MetaExprList
(name
,Ast0.MetaListLen lenname
,_
) ->
169 check_table table minus name
;
170 check_table table minus lenname
171 | Ast0.MetaExprList
(name
,_
,_
) ->
172 check_table table minus name
173 | Ast0.DisjExpr
(_
,exps
,_
,_
) ->
174 List.iter
(expression context old_metas table minus
) exps
175 | Ast0.NestExpr
(_
,exp_dots
,_
,w
,_
) ->
176 dots (expression ID old_metas table minus
) exp_dots
;
177 get_opt (expression ID old_metas table minus
) w
178 | Ast0.Edots
(_
,Some x
) | Ast0.Ecircles
(_
,Some x
) | Ast0.Estars
(_
,Some x
) ->
179 expression ID old_metas table minus x
180 | _
-> () (* no metavariable subterms *)
182 and get_type_name
= function
183 Type_cocci.ConstVol
(_
,ty
) | Type_cocci.SignedT
(_
,Some ty
)
184 | Type_cocci.Pointer
(ty
)
185 | Type_cocci.FunctionPointer
(ty
) | Type_cocci.Array
(ty
) -> get_type_name ty
186 | Type_cocci.MetaType
(nm
,_
,_
) -> Some nm
189 (* --------------------------------------------------------------------- *)
192 and typeC old_metas table minus t
=
193 match Ast0.unwrap t
with
194 Ast0.ConstVol
(cv
,ty
) -> typeC old_metas table minus ty
195 | Ast0.Signed
(sgn
,ty
) ->
196 get_opt (typeC old_metas table minus
) ty
197 | Ast0.Pointer
(ty
,star
) -> typeC old_metas table minus ty
198 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
199 typeC old_metas table minus ty
;
200 parameter_list old_metas table minus params
201 | Ast0.FunctionType
(ty
,lp1
,params
,rp1
) ->
202 get_opt (typeC old_metas table minus
) ty
;
203 parameter_list old_metas table minus params
204 | Ast0.Array
(ty
,lb
,size
,rb
) ->
205 typeC old_metas table minus ty
;
206 get_opt (expression ID old_metas table minus
) size
207 | Ast0.MetaType
(name
,_
) ->
208 check_table table minus name
209 | Ast0.DisjType
(_
,types
,_
,_
) ->
210 List.iter
(typeC old_metas table minus
) types
211 | Ast0.EnumName
(en
,id
) -> ident GLOBAL old_metas table minus id
212 | Ast0.StructUnionName
(su
,Some id
) -> ident GLOBAL old_metas table minus id
213 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
214 typeC old_metas table minus ty
;
215 dots (declaration GLOBAL old_metas table minus
) decls
216 | Ast0.OptType
(ty
) | Ast0.UniqueType
(ty
) ->
217 failwith
"unexpected code"
218 | _
-> () (* no metavariable subterms *)
220 (* --------------------------------------------------------------------- *)
221 (* Variable declaration *)
222 (* Even if the Cocci program specifies a list of declarations, they are
223 split out into multiple declarations of a single variable each. *)
225 and declaration context old_metas table minus d
=
226 match Ast0.unwrap d
with
227 Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
228 (match Ast0.unwrap ini
with
230 typeC old_metas table minus ty
;
231 ident context old_metas table minus id
;
232 expression ID old_metas table minus exp
237 failwith "complex initializer specification not allowed in - code"
239 (typeC old_metas table minus ty
;
240 ident context old_metas table minus id
;
241 initialiser old_metas table minus ini
))
242 | Ast0.UnInit
(stg
,ty
,id
,sem
) ->
243 typeC old_metas table minus ty
; ident context old_metas table minus id
244 | Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
245 ident GLOBAL old_metas table minus name
;
246 dots (expression ID old_metas table minus
) args
247 | Ast0.TyDecl
(ty
,sem
) -> typeC old_metas table minus ty
248 | Ast0.Typedef
(stg
,ty
,id
,sem
) ->
249 typeC old_metas table minus ty
;
250 typeC old_metas table minus id
251 | Ast0.DisjDecl
(_
,decls
,_
,_
) ->
252 List.iter
(declaration ID old_metas table minus
) decls
253 | Ast0.Ddots
(_
,Some x
) -> declaration ID old_metas table minus x
254 | Ast0.Ddots
(_
,None
) -> ()
255 | Ast0.OptDecl
(_
) | Ast0.UniqueDecl
(_
) ->
256 failwith
"unexpected code"
258 (* --------------------------------------------------------------------- *)
261 and initialiser old_metas table minus ini
=
262 match Ast0.unwrap ini
with
263 Ast0.MetaInit
(name
,_
) ->
264 check_table table minus name
265 | Ast0.InitExpr
(exp
) -> expression ID old_metas table minus exp
266 | Ast0.InitList
(lb
,initlist
,rb
) ->
267 dots (initialiser old_metas table minus
) initlist
268 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
269 List.iter
(designator old_metas table minus
) designators
;
270 initialiser old_metas table minus ini
271 | Ast0.InitGccName
(name
,eq
,ini
) ->
272 ident FIELD old_metas table minus name
;
273 initialiser old_metas table minus ini
274 | Ast0.Idots
(_
,Some x
) -> initialiser old_metas table minus x
275 | Ast0.OptIni
(_
) | Ast0.UniqueIni
(_
) ->
276 failwith
"unexpected code"
277 | _
-> () (* no metavariable subterms *)
279 and designator old_metas table minus
= function
280 Ast0.DesignatorField
(dot
,id
) ->
281 ident FIELD old_metas table minus id
282 | Ast0.DesignatorIndex
(lb
,exp
,rb
) ->
283 expression ID old_metas table minus exp
284 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
285 expression ID old_metas table minus min
;
286 expression ID old_metas table minus max
288 and initialiser_list old_metas table minus
=
289 dots (initialiser old_metas table minus
)
291 (* --------------------------------------------------------------------- *)
294 and parameterTypeDef old_metas table minus param
=
295 match Ast0.unwrap param
with
297 get_opt (ident ID old_metas table minus
) id
;
298 typeC old_metas table minus ty
299 | Ast0.MetaParam
(name
,_
) ->
300 check_table table minus name
301 | Ast0.MetaParamList
(name
,Ast0.MetaListLen lenname
,_
) ->
302 check_table table minus name
;
303 check_table table minus lenname
304 | Ast0.MetaParamList
(name
,_
,_
) ->
305 check_table table minus name
306 | _
-> () (* no metavariable subterms *)
308 and parameter_list old_metas table minus
=
309 dots (parameterTypeDef old_metas table minus
)
311 (* --------------------------------------------------------------------- *)
314 and statement old_metas table minus s
=
315 match Ast0.unwrap s
with
316 Ast0.Decl
(_
,decl
) -> declaration ID old_metas table minus decl
317 | Ast0.Seq
(lbrace
,body
,rbrace
) -> dots (statement old_metas table minus
) body
318 | Ast0.ExprStatement
(exp
,sem
) -> expression ID old_metas table minus exp
319 | Ast0.IfThen
(iff
,lp
,exp
,rp
,branch
,_
) ->
320 expression ID old_metas table minus exp
;
321 statement old_metas table minus branch
322 | Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,_
) ->
323 expression ID old_metas table minus exp
;
324 statement old_metas table minus branch1
;
325 statement old_metas table minus branch2
326 | Ast0.While
(wh
,lp
,exp
,rp
,body
,_
) ->
327 expression ID old_metas table minus exp
;
328 statement old_metas table minus body
329 | Ast0.Do
(d
,body
,wh
,lp
,exp
,rp
,sem
) ->
330 statement old_metas table minus body
;
331 expression ID old_metas table minus exp
332 | Ast0.For
(fr
,lp
,exp1
,sem1
,exp2
,sem2
,exp3
,rp
,body
,_
) ->
333 get_opt (expression ID old_metas table minus
) exp1
;
334 get_opt (expression ID old_metas table minus
) exp2
;
335 get_opt (expression ID old_metas table minus
) exp3
;
336 statement old_metas table minus body
337 | Ast0.Iterator
(nm
,lp
,args
,rp
,body
,_
) ->
338 ident GLOBAL old_metas table minus nm
;
339 dots (expression ID old_metas table minus
) args
;
340 statement old_metas table minus body
341 | Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,decls
,cases
,rb
) ->
342 expression ID old_metas table minus exp
;
343 dots (statement old_metas table minus
) decls
;
344 dots (case_line old_metas table minus
) cases
345 | Ast0.ReturnExpr
(ret
,exp
,sem
) -> expression ID old_metas table minus exp
346 | Ast0.MetaStmt
(name
,_
) -> check_table table minus name
347 | Ast0.MetaStmtList
(name
,_
) -> check_table table minus name
348 | Ast0.Exp
(exp
) -> expression ID old_metas table minus exp
349 | Ast0.TopExp
(exp
) -> expression ID old_metas table minus exp
350 | Ast0.Ty
(ty
) -> typeC old_metas table minus ty
351 | Ast0.TopInit
(init
) -> initialiser old_metas table minus init
352 | Ast0.Disj
(_
,rule_elem_dots_list
,_
,_
) ->
353 List.iter
(dots (statement old_metas table minus
)) rule_elem_dots_list
354 | Ast0.Nest
(_
,rule_elem_dots
,_
,w
,_
) ->
355 dots (statement old_metas table minus
) rule_elem_dots
;
356 List.iter
(whencode
(dots (statement old_metas table minus
))
357 (statement old_metas table minus
)
358 (expression ID old_metas table minus
))
360 | Ast0.Dots
(_
,x
) | Ast0.Circles
(_
,x
) | Ast0.Stars
(_
,x
) ->
362 (whencode
(dots (statement old_metas table minus
))
363 (statement old_metas table minus
)
364 (expression ID old_metas table minus
)) x
365 | Ast0.FunDecl
(_
,fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
) ->
366 ident FN old_metas table minus name
;
367 List.iter
(fninfo old_metas table minus
) fi
;
368 parameter_list old_metas table minus params
;
369 dots (statement old_metas table minus
) body
370 | Ast0.Include
(inc
,s
) -> () (* no metavariables possible *)
371 | Ast0.Define
(def
,id
,params
,body
) ->
372 ident GLOBAL old_metas table minus id
;
373 define_parameters old_metas table minus params
;
374 dots (statement old_metas table minus
) body
375 | Ast0.Label
(i
,_
) -> ident ID old_metas table minus i
376 | Ast0.Goto
(_
,i
,_
) -> ident ID old_metas table minus i
377 | _
-> () (* no metavariable subterms *)
379 and define_param old_metas table minus p
=
380 match Ast0.unwrap p
with
381 Ast0.DParam
(id
) -> ident GLOBAL old_metas table minus id
382 | Ast0.DPComma
(_
) | Ast0.DPdots
(_
) | Ast0.DPcircles
(_
) ->
383 () (* no metavariable subterms *)
384 | Ast0.OptDParam
(dp
) -> define_param old_metas table minus dp
385 | Ast0.UniqueDParam
(dp
) -> define_param old_metas table minus dp
387 and define_parameters old_metas table minus x
=
388 match Ast0.unwrap x
with
390 | Ast0.DParams
(lp
,dp
,rp
) -> dots (define_param old_metas table minus
) dp
392 and fninfo old_metas table minus
= function
393 Ast0.FStorage
(stg
) -> ()
394 | Ast0.FType
(ty
) -> typeC old_metas table minus ty
395 | Ast0.FInline
(inline
) -> ()
396 | Ast0.FAttr
(attr
) -> ()
398 and whencode notfn alwaysfn
expression = function
399 Ast0.WhenNot a
-> notfn a
400 | Ast0.WhenAlways a
-> alwaysfn a
401 | Ast0.WhenModifier
(_
) -> ()
402 | Ast0.WhenNotTrue a
-> expression a
403 | Ast0.WhenNotFalse a
-> expression a
405 and case_line old_metas table minus c
=
406 match Ast0.unwrap c
with
407 Ast0.Default
(def
,colon
,code
) ->
408 dots (statement old_metas table minus
) code
409 | Ast0.Case
(case
,exp
,colon
,code
) ->
410 dots (statement old_metas table minus
) code
411 | Ast0.DisjCase
(_
,case_lines
,_
,_
) ->
412 List.iter
(case_line old_metas table minus
) case_lines
413 | Ast0.OptCase
(case
) -> failwith
"unexpected code"
415 (* --------------------------------------------------------------------- *)
418 let top_level old_metas table minus t
=
419 match Ast0.unwrap t
with
420 Ast0.DECL
(stmt
) -> statement old_metas table minus stmt
421 | Ast0.CODE
(stmt_dots
) -> dots (statement old_metas table minus
) stmt_dots
422 | Ast0.ERRORWORDS
(exps
) ->
423 List.iter
(expression FN old_metas table minus
) exps
424 | _
-> () (* no metavariables possible *)
426 let rule old_metas table minus rules
=
427 List.iter
(top_level old_metas table minus
) rules
429 (* --------------------------------------------------------------------- *)
431 let positions table rules
=
433 match Ast0.get_pos x
with
434 Ast0.MetaPos
(name
,constraints
,_
) ->
435 let pos = Ast0.unwrap_mcode name
in
436 (find_loop table
pos) := true
438 let option_default = () in
440 let donothing r k e
= k e
in
442 V0.flat_combiner
bind option_default
443 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
444 donothing donothing donothing donothing donothing donothing
445 donothing donothing donothing donothing donothing donothing donothing
446 donothing donothing in
448 List.iter
fn.VT0.combiner_rec_top_level rules
450 let dup_positions rules
=
452 match Ast0.get_pos x
with
453 Ast0.MetaPos
(name
,constraints
,_
) ->
454 let pos = Ast0.unwrap_mcode name
in [pos]
456 let option_default = [] in
457 let bind x y
= x
@y
in
459 (* Case for everything that has a disj.
460 Note, no positions on ( | ) of a disjunction, so no need to recurse on
463 let expression r k e
=
464 match Ast0.unwrap e
with
465 Ast0.DisjExpr
(_
,explist
,_
,_
) ->
466 List.fold_left
Common.union_set
option_default
467 (List.map r
.VT0.combiner_rec_expression explist
)
470 let typeC r k e
= (* not sure relevent because "only after iso" *)
471 match Ast0.unwrap e
with
472 Ast0.DisjType
(_
,types
,_
,_
) ->
473 List.fold_left
Common.union_set
option_default
474 (List.map r
.VT0.combiner_rec_typeC types
)
477 let declaration r k e
=
478 match Ast0.unwrap e
with
479 Ast0.DisjDecl
(_
,decls
,_
,_
) ->
480 List.fold_left
Common.union_set
option_default
481 (List.map r
.VT0.combiner_rec_declaration decls
)
484 let statement r k e
=
485 match Ast0.unwrap e
with
486 Ast0.Disj
(_
,stmts
,_
,_
) ->
487 List.fold_left
Common.union_set
option_default
488 (List.map r
.VT0.combiner_rec_statement_dots stmts
)
491 let donothing r k e
= k e
in
493 V0.flat_combiner
bind option_default
494 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
495 donothing donothing donothing donothing donothing donothing
496 donothing expression typeC donothing donothing declaration statement
497 donothing donothing in
501 (List.fold_left
Common.union_set
option_default
502 (List.map
fn.VT0.combiner_rec_top_level rules
)) in
503 let rec loop = function
505 | ((rule,name
) as x
)::y
::_
when x
= y
->
507 (Printf.sprintf
"duplicate use of %s.%s" rule name
)
508 | _
::xs
-> loop xs
in
511 (* --------------------------------------------------------------------- *)
515 (Hashtbl.create
(List.length l
) :
516 (Ast.meta_name
, bool ref) Hashtbl.t
) in
518 (function x
-> Hashtbl.add
table (Ast.get_meta_name x
) (ref false)) l
;
521 let add_to_fresh_table l
=
524 let name = Ast.get_meta_name x
in Hashtbl.replace
fresh_table name ())
527 let check_all_marked rname
err table after_err
=
533 let (_
,name) = name in
535 (Printf.sprintf
"%s: %s %s not used %s" rname
err name after_err
))
538 let check_meta rname old_metas inherited_metavars metavars minus plus
=
540 List.map
(function (_
,x
) -> x
) (List.map
Ast.get_meta_name
old_metas) in
542 List.partition
(function Ast.MetaFreshIdDecl
(_
,_
) -> true | _
-> false)
545 List.partition
(function Ast.MetaErrDecl
(_
,_
) -> true | _
-> false)
548 List.partition
(function Ast.MetaErrDecl
(_
,_
) -> true | _
-> false)
549 inherited_metavars
in
550 let fresh_table = make_table fresh
in
551 let err_table = make_table (err@ierr
) in
552 let other_table = make_table other
in
553 let iother_table = make_table iother
in
554 add_to_fresh_table fresh
;
555 rule old_metas [iother_table;other_table;err_table] true minus
;
556 positions [iother_table;other_table] minus
;
558 check_all_marked rname
"metavariable" other_table "in the - or context code";
559 rule old_metas [iother_table;fresh_table;err_table] false plus
;
560 check_all_marked rname
"inherited metavariable" iother_table
561 "in the -, +, or context code";
562 check_all_marked rname
"metavariable" fresh_table "in the + code";
563 check_all_marked rname
"error metavariable" err_table ""