(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+(* Yoann Padioleau, Julia Lawall
+ *
+ * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * file license.txt for more details.
+ *
+ * This file was part of Coccinelle.
+ *)
+
open Common
module A = Ast_cocci
type sequence = Ordered | Unordered
-let seqstyle eas =
- match A.unwrap eas with
- | A.DOTS _ -> Ordered
- | A.CIRCLES _ -> Unordered
+let seqstyle eas =
+ match A.unwrap eas with
+ | A.DOTS _ -> Ordered
+ | A.CIRCLES _ -> Unordered
| A.STARS _ -> failwith "not handling stars"
let (redots : 'a A.dots -> 'a list -> 'a A.dots)=fun eas easundots ->
| A.CONTEXT _ -> true
| A.MINUS (_,_,_,[]) -> false
| A.MINUS (_,_,_,x::xs) -> true
- | A.PLUS -> raise Impossible
+ | A.PLUS _ -> raise Impossible
let mcode_simple_minus = function
| A.MINUS (_,_,_,[]) -> true
let (s1, i, mck, pos) = ia in
let new_mck =
match mck with
- | A.PLUS -> raise Impossible
+ | A.PLUS _ -> raise Impossible
| A.CONTEXT (A.NoPos,x) ->
A.CONTEXT (A.DontCarePos,x)
| A.MINUS (A.NoPos,inst,adj,x) ->
| Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) ->
Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2
-
+
| Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 ->
List.exists
(function (fla,cea,posa1,posa2) ->
), _
-> raise Impossible
-let equal_inh_metavarval valu valu' =
+(* probably only one argument needs to be stripped, because inherited
+metavariables containing expressions are stripped in advance. But don't
+know which one is which... *)
+let equal_inh_metavarval valu valu'=
match valu, valu' with
| Ast_c.MetaIdVal a, Ast_c.MetaIdVal b -> a =$= b
| Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b
(unit -> Common.filename * string * Ast_c.posl * Ast_c.posl) ->
(unit -> tin -> 'x tout) -> (tin -> 'x tout)
- val check_constraints :
+ val check_idconstraint :
+ ('a -> 'b -> bool) -> 'a -> 'b ->
+ (unit -> tin -> 'x tout) -> (tin -> 'x tout)
+
+ val check_constraints_ne :
('a, 'b) matcher -> 'a list -> 'b ->
(unit -> tin -> 'x tout) -> (tin -> 'x tout)
(*****************************************************************************)
module COCCI_VS_C =
- functor (X : PARAM) ->
+ functor (X : PARAM) ->
struct
type ('a, 'b) matcher = 'a -> 'b -> X.tin -> ('a * 'b) X.tout
let dots2metavar (_,info,mcodekind,pos) = (("","..."),info,mcodekind,pos)
let metavar2dots (_,info,mcodekind,pos) = ("...",info,mcodekind,pos)
+let satisfies_iconstraint c id : bool =
+ match c with
+ A.IdNoConstraint -> true
+ | A.IdNegIdSet l -> not (List.mem id l)
+ | A.IdRegExp (_,recompiled) ->
+ if Str.string_match recompiled id 0 then
+ true
+ else
+ false
+ | A.IdNotRegExp (_,recompiled) ->
+ if Str.string_match recompiled id 0 then
+ false
+ else
+ true
+
+let satisfies_econstraint c exp : bool =
+ match Ast_c.unwrap_expr exp with
+ Ast_c.Ident (name) ->
+ (
+ match name with
+ Ast_c.RegularName rname -> satisfies_iconstraint c (Ast_c.unwrap_st rname)
+ | Ast_c.CppConcatenatedName _ ->
+ pr2_once ("WARNING: Unable to apply a constraint on a CppConcatenatedName identifier !"); true
+ | Ast_c.CppVariadicName _ ->
+ pr2_once ("WARNING: Unable to apply a constraint on a CppVariadicName identifier !"); true
+ | Ast_c.CppIdentBuilder _ ->
+ pr2_once ("WARNING: Unable to apply a constraint on a CppIdentBuilder identifier !"); true
+ )
+ | Ast_c.Constant cst ->
+ (match cst with
+ | Ast_c.String (str, _) -> satisfies_iconstraint c str
+ | Ast_c.MultiString strlist ->
+ pr2_once ("WARNING: Unable to apply a constraint on an multistring constant !"); true
+ | Ast_c.Char (char , _) -> satisfies_iconstraint c char
+ | Ast_c.Int (int , _) -> satisfies_iconstraint c int
+ | Ast_c.Float (float, _) -> satisfies_iconstraint c float
+ )
+ | _ -> pr2_once ("WARNING: Unable to apply a constraint on an expression !"); true
+
(*---------------------------------------------------------------------------*)
(* toc:
* - expression
let s = Ast_c.str_of_name nameidb in
if s =~ "^[A-Z_][A-Z_0-9]*$"
then begin
- pr2_once ("warning: I consider " ^ s ^ " as a constant");
+ pr2_once ("warning: " ^ s ^ " treated as a constant");
true
end
else false
pr2_once ("Missing type information. Certainly a pb in " ^
"annotate_typer.ml");
fail
-
- | Some tas, Some tb ->
- tas +> List.fold_left (fun acc ta ->
+
+ | Some tas, Some tb ->
+ tas +> List.fold_left (fun acc ta ->
acc >|+|> compatible_type ta tb) fail
) >>=
(fun () () ->
- X.check_constraints expression constraints eb
- (fun () ->
- let max_min _ =
- Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
- X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
- (fun () ->
- X.distrf_e ida expb >>= (fun ida expb ->
- return (
- A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
- A.rewrap ea,
- expb
- ))
- )))
+ match constraints with
+ Ast_cocci.NoConstraint ->
+ let max_min _ =
+ Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
+ X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
+ (fun () ->
+ X.distrf_e ida expb >>=
+ (fun ida expb ->
+ return (
+ A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
+ A.rewrap ea,
+ expb
+ ))
+ )
+
+ | Ast_cocci.NotIdCstrt cstrt ->
+ X.check_idconstraint satisfies_econstraint cstrt eb
+ (fun () ->
+ let max_min _ =
+ Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
+ X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
+ (fun () ->
+ X.distrf_e ida expb >>=
+ (fun ida expb ->
+ return (
+ A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
+ A.rewrap ea,
+ expb
+ ))
+ ))
+
+ | Ast_cocci.NotExpCstrt cstrts ->
+ X.check_constraints_ne expression cstrts eb
+ (fun () ->
+ let max_min _ =
+ Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
+ X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
+ (fun () ->
+ X.distrf_e ida expb >>=
+ (fun ida expb ->
+ return (
+ A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
+ A.rewrap ea,
+ expb
+ ))
+ )))
else fail
-
+
(* old:
* | A.MetaExpr(ida,false,opttypa,_inherited), expb ->
* D.distribute_mck (mcodekind ida) D.distribute_mck_e expb binding
fail
and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) =
- fun infoidb ida ((idb, iib) as ib) ->
+ fun infoidb ida ((idb, iib)) -> (* (idb, iib) as ib *)
X.all_bound (A.get_inherited ida) >&&>
match A.unwrap ida with
| A.Id sa ->
))
else fail
-
| A.MetaId(mida,constraints,keep,inherited) ->
- X.check_constraints (ident infoidb) constraints ib
+ X.check_idconstraint satisfies_iconstraint constraints idb
(fun () ->
let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
(* use drop_pos for ids so that the pos is not added a second time in
| A.MetaFunc(mida,constraints,keep,inherited) ->
let is_function _ =
- X.check_constraints (ident infoidb) constraints ib
+ X.check_idconstraint satisfies_iconstraint constraints idb
(fun () ->
let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
X.envf keep inherited (A.drop_pos mida,Ast_c.MetaFuncVal idb,max_min)
| A.MetaLocalFunc(mida,constraints,keep,inherited) ->
(match infoidb with
| LocalFunction ->
- X.check_constraints (ident infoidb) constraints ib
+ X.check_idconstraint satisfies_iconstraint constraints idb
(fun () ->
let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
X.envf keep inherited
if optwhen <> None then failwith "not handling when in argument";
(* '...' can take more or less the beginnings of the arguments *)
- let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
+ let startendxs =
+ if eas = []
+ then [(ys,[])] (* hack! the only one that can work *)
+ else Common.zip (Common.inits ys) (Common.tails ys) in
startendxs +> List.fold_left (fun acc (startxs, endxs) ->
acc >||> (
| _ -> fail in
process_type
- >>= (fun ty ii_sub_sb ->
+ >>= (fun ty ii_sub_sb ->
tokenf lba lbb >>= (fun lba lbb ->
tokenf rba rbb >>= (fun rba rbb ->
let default = A.MetaRuleElem(mcode,keep,inherited), unwrap_node in
(match unwrap_node with
| F.CaseNode _
- | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
+ | F.TrueNode | F.FalseNode | F.AfterNode
+ | F.LoopFallThroughNode | F.FallThroughNode
| F.InLoopNode ->
if X.mode =*= PatternMode
then return default
* TODO: and F.Fake ?
*)
| _, F.EndStatement _ | _, F.CaseNode _
- | _, F.TrueNode | _, F.FalseNode | _, F.AfterNode | _, F.FallThroughNode
+ | _, F.TrueNode | _, F.FalseNode | _, F.AfterNode
+ | _, F.FallThroughNode | _, F.LoopFallThroughNode
| _, F.InLoopNode
-> fail2()
HCoop / bpt / coccinelle.git / blobdiff