Release coccinelle-0.1.8
[bpt/coccinelle.git] / parsing_cocci / parse_cocci.ml
index 91c0768..209ab97 100644 (file)
@@ -26,6 +26,7 @@ separately (thus duplicating work for the parsing of the context elements) *)
 module D = Data
 module PC = Parser_cocci_menhir
 module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
 module Ast = Ast_cocci
 module Ast0 = Ast0_cocci
 let pr = Printf.sprintf
@@ -109,11 +110,11 @@ let token2c (tok,_) =
   | PC.Tconst(clt) -> "const"^(line_type2c clt)
   | PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
 
-  | PC.TPragma(s) -> s
+  | PC.TPragma(s,_) -> s
   | PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
   | PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
   | PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
-  | PC.TDefineParam(clt,_,_) -> "#define_param"^(line_type2c clt)
+  | PC.TDefineParam(clt,_,_,_) -> "#define_param"^(line_type2c clt)
   | PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt)
   | PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt)
 
@@ -199,6 +200,8 @@ let token2c (tok,_) =
   | PC.TArob -> "@"
   | PC.TPArob -> "P@"
   | PC.TScript -> "script"
+  | PC.TInitialize -> "initialize"
+  | PC.TFinalize -> "finalize"
 
   | PC.TWhen(clt) -> "WHEN"^(line_type2c clt)
   | PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt)
@@ -272,7 +275,7 @@ let print_tokens s tokens =
 
 type plus = PLUS | NOTPLUS | SKIP
 
-let plus_attachable (tok,_) =
+let plus_attachable only_plus (tok,_) =
   match tok with
     PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
   | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
@@ -283,7 +286,7 @@ let plus_attachable (tok,_) =
   | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
 
   | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
-  | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+  | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
 
   | PC.TInc(clt) | PC.TDec(clt)
 
@@ -325,7 +328,10 @@ let plus_attachable (tok,_) =
 
   | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
   | PC.TPtVirg(clt) ->
-      if line_type clt = D.PLUS then PLUS else NOTPLUS
+      if line_type clt = D.PLUS
+      then PLUS
+      else if only_plus then NOTPLUS
+      else if line_type clt = D.CONTEXT then PLUS else NOTPLUS
 
   | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
   | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
@@ -345,7 +351,7 @@ let get_clt (tok,_) =
   | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
 
   | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
-  | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+  | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
 
   | PC.TInc(clt) | PC.TDec(clt)
 
@@ -422,7 +428,7 @@ let update_clt (tok,x) clt =
   | PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x)
   | PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x)
   | PC.TDefine(_,a) -> (PC.TDefine(clt,a),x)
-  | PC.TDefineParam(_,a,b) -> (PC.TDefineParam(clt,a,b),x)
+  | PC.TDefineParam(_,a,b,c) -> (PC.TDefineParam(clt,a,b,c),x)
   | PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x)
   | PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x)
 
@@ -604,11 +610,11 @@ let split_token ((tok,_) as t) =
   | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
   | PC.Tconst(clt) | PC.Tvolatile(clt) -> split t clt
 
-  | PC.TPragma(s) -> ([],[t]) (* only allowed in + *)
+  | PC.TPragma(s,_) -> ([],[t]) (* only allowed in + *)
   | PC.TPlusFile(s,clt) | PC.TMinusFile(s,clt)
   | PC.TIncludeL(s,clt) | PC.TIncludeNL(s,clt) ->
       split t clt
-  | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_) -> split t clt
+  | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_) -> split t clt
 
   | PC.TIf(clt) | PC.TElse(clt)  | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
   | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt)
@@ -624,7 +630,8 @@ let split_token ((tok,_) as t) =
   | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaErr(_,_,_,clt)
   | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt)
   | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
-  | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript -> ([t],[t])
+  | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript
+  | PC.TInitialize | PC.TFinalize -> ([t],[t])
   | PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
 
   | PC.TFunDecl(clt)
@@ -880,7 +887,7 @@ let token2line (tok,_) =
 
   | PC.TPtrOp(clt)
 
-  | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_)
+  | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_)
   | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
 
   | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
@@ -894,7 +901,7 @@ let rec insert_line_end = function
   | (((PC.TWhen(clt),q) as x)::xs) ->
       x::(find_line_end true (token2line x) clt q xs)
   | (((PC.TDefine(clt,_),q) as x)::xs)
-  | (((PC.TDefineParam(clt,_,_),q) as x)::xs) ->
+  | (((PC.TDefineParam(clt,_,_,_),q) as x)::xs) ->
       x::(find_line_end false (token2line x) clt q xs)
   | x::xs -> x::(insert_line_end xs)
 
@@ -963,51 +970,71 @@ let find_top_init tokens =
   | _ -> tokens
 
 (* ----------------------------------------------------------------------- *)
-(* process pragmas: they can only be used in + code, and adjacent to
-another + token.  They are concatenated to the string representation of
-that other token. *)
+(* Integrate pragmas into some adjacent token.  + tokens are preferred.  Dots
+are not allowed. *)
 
 let rec collect_all_pragmas collected = function
-    (PC.TPragma(s),_)::rest -> collect_all_pragmas (s::collected) rest
+    (PC.TPragma(s,(_,line,logical_line,offset,col,_,_,pos)),_)::rest ->
+      let i =
+       { Ast0.line_start = line; Ast0.line_end = line;
+         Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
+         Ast0.column = col; Ast0.offset = offset; } in
+      collect_all_pragmas ((s,i)::collected) rest
   | l -> (List.rev collected,l)
 
-let rec collect_up_to_pragmas skipped = function
-    [] -> None (* didn't reach a pragma, so nothing to do *)
-  | ((PC.TPragma(s),_) as t)::rest ->
-      let (pragmas,rest) = collect_all_pragmas [] (t::rest) in
-      Some (List.rev skipped,pragmas,rest)
+let rec collect_pass = function
+    [] -> ([],[])
   | x::xs ->
-      match plus_attachable x with
-       PLUS -> None
-      |        NOTPLUS -> None
-      |        SKIP -> collect_up_to_pragmas (x::skipped) xs
-
-let rec collect_up_to_plus skipped = function
-    [] -> failwith "nothing to attach a pragma to (empty)"
-  | x::xs ->
-      match plus_attachable x with
-       PLUS -> (List.rev skipped,x,xs)
-      |        NOTPLUS -> failwith "nothing to attach a pragma to"
-      |        SKIP -> collect_up_to_plus (x::skipped) xs
-
-let rec process_pragmas = function
-    [] -> []
-  | ((PC.TPragma(s),_)::_) as l ->
+      match plus_attachable false x with
+       SKIP ->
+         let (pass,rest) = collect_pass xs in
+         (x::pass,rest)
+      |        _ -> ([],x::xs)
+
+let plus_attach strict = function
+    None -> NOTPLUS
+  | Some x -> plus_attachable strict x
+
+let add_bef = function Some x -> [x] | None -> []
+
+(*skips should be things like line end
+skips is things before pragmas that can't be attached to, pass is things
+after.  pass is used immediately.  skips accumulates. *)
+let rec process_pragmas bef skips = function
+    [] -> add_bef bef @ List.rev skips
+  | ((PC.TPragma(s,i),_)::_) as l ->
       let (pragmas,rest) = collect_all_pragmas [] l in
-      let (skipped,aft,rest) = collect_up_to_plus [] rest in
-      let (a,b,c,d,e,strbef,straft,pos) = get_clt aft in
-      skipped@
-      (process_pragmas ((update_clt aft (a,b,c,d,e,pragmas,straft,pos))::rest))
-  | bef::xs ->
-      (match plus_attachable bef with
-       PLUS ->
-         (match collect_up_to_pragmas [] xs with
-           Some(skipped,pragmas,rest) ->
+      let (pass,rest0) = collect_pass rest in
+      let (next,rest) =
+       match rest0 with [] -> (None,[]) | next::rest -> (Some next,rest) in
+      (match (bef,plus_attach true bef,next,plus_attach true next) with
+       (Some bef,PLUS,_,_) ->
+         let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
+         (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
+         pass@process_pragmas None [] rest0
+      |        (_,_,Some next,PLUS) ->
+         let (a,b,c,d,e,strbef,straft,pos) = get_clt next in
+         (add_bef bef) @ List.rev skips @ pass @
+         (process_pragmas
+            (Some (update_clt next (a,b,c,d,e,pragmas,straft,pos)))
+            [] rest)
+      |        _ ->
+         (match (bef,plus_attach false bef,next,plus_attach false next) with
+           (Some bef,PLUS,_,_) ->
              let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
-             (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::
-             skipped@(process_pragmas rest)
-         | None -> bef::(process_pragmas xs))
-      |        _ -> bef::(process_pragmas xs))
+             (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
+             pass@process_pragmas None [] rest0
+         | (_,_,Some next,PLUS) ->
+             let (a,b,c,d,e,strbef,straft,pos) = get_clt next in
+             (add_bef bef) @ List.rev skips @ pass @
+             (process_pragmas
+                (Some (update_clt next (a,b,c,d,e,pragmas,straft,pos)))
+                [] rest)
+         | _ -> failwith "nothing to attach pragma to"))
+  | x::xs ->
+      (match plus_attachable false x with
+       SKIP -> process_pragmas bef (x::skips) xs
+      |        _ -> (add_bef bef) @ List.rev skips @ (process_pragmas (Some x) [] xs))
 
 (* ----------------------------------------------------------------------- *)
 (* Drop ... ... .  This is only allowed in + code, and arises when there is
@@ -1192,12 +1219,12 @@ let any_modif rule =
   let bind x y = x or y in
   let option_default = false in
   let fn =
-    V0.combiner bind option_default
+    V0.flat_combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
       donothing donothing donothing donothing donothing donothing
       donothing donothing donothing donothing donothing donothing donothing
       donothing donothing in
-  List.exists fn.V0.combiner_top_level rule
+  List.exists fn.VT0.combiner_rec_top_level rule
 
 let drop_last extra l = List.rev(extra@(List.tl(List.rev l)))
 
@@ -1254,6 +1281,8 @@ let get_rule_name parse_fn starts_with_name get_tokens file prefix =
       | Ast.GeneratedRulename (nm,a,b,c,d,e) ->
           Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
       | Ast.ScriptRulename(s,deps) -> Ast.ScriptRulename(s,deps)
+      | Ast.InitialScriptRulename(s) -> Ast.InitialScriptRulename(s)
+      | Ast.FinalScriptRulename(s) -> Ast.FinalScriptRulename(s)
     else
       Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
   Data.in_rule_name := false;
@@ -1391,7 +1420,7 @@ let parse file =
            *)
 
            let plus_tokens =
-             process_pragmas
+             process_pragmas None []
                (fix (function x -> drop_double_dots (drop_empty_or x))
                   (drop_when plus_tokens)) in
            (*
@@ -1410,7 +1439,7 @@ let parse file =
              if !Flag.sgrep_mode2
              then (* not actually used for anything, except context_neg *)
                List.map
-                 (Iso_pattern.rebuild_mcode None).V0.rebuilder_top_level
+                 (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_top_level
                  minus_res
              else
                if is_expression
@@ -1465,6 +1494,28 @@ let parse file =
               | _ -> failwith "Malformed script rule" in
             (more,Ast0.ScriptRule(language, deps, metavars, data),[],tokens) in
 
+          let parse_if_script_rule k language =
+            let get_tokens = tokens_script_all table file false lexbuf in
+
+              (* script code *)
+            let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
+            let data =
+              match List.hd tokens with
+                (PC.TScriptData(s),_) -> s
+              | (PC.TArobArob,_) | (PC.TArob,_) -> ""
+              | _ -> failwith "Malformed script rule" in
+            (more,k (language, data),[],tokens) in
+
+         let parse_iscript_rule =
+           parse_if_script_rule
+             (function (language,data) ->
+               Ast0.InitialScriptRule(language,data)) in
+
+         let parse_fscript_rule =
+           parse_if_script_rule
+             (function (language,data) ->
+               Ast0.FinalScriptRule(language,data)) in
+
           let parse_rule old_metas starts_with_name =
             let rulename =
              get_rule_name PC.rule_name starts_with_name get_tokens file
@@ -1478,7 +1529,9 @@ let parse file =
                  parse_cocci_rule Ast.Generated old_metas (s,a,b,c,d,e) in
                Data.in_generating := false;
                res
-            | Ast.ScriptRulename (l,deps) -> parse_script_rule l old_metas deps
+            | Ast.ScriptRulename(l,deps) -> parse_script_rule l old_metas deps
+            | Ast.InitialScriptRulename(l) -> parse_iscript_rule l
+            | Ast.FinalScriptRulename(l) -> parse_fscript_rule l
             | _ -> failwith "Malformed rule name"
             in
 
@@ -1524,6 +1577,8 @@ let process file isofile verbose =
     List.map
       (function
           Ast0.ScriptRule (a,b,c,d) -> [([],Ast.ScriptRule (a,b,c,d))]
+       | Ast0.InitialScriptRule (a,b) -> [([],Ast.InitialScriptRule (a,b))]
+       | Ast0.FinalScriptRule (a,b) -> [([],Ast.FinalScriptRule (a,b))]
        | Ast0.CocciRule
            ((minus, metavarsm,
              (iso, dropiso, dependencies, rule_name, exists)),
@@ -1586,6 +1641,7 @@ let process file isofile verbose =
               let ((metavars,minus),function_prototypes) =
                 Function_prototypes.process
                   rule_name metavars dropped_isos minus plus ruletype in
+              let plus = Adjust_pragmas.process plus in
           (* warning! context_neg side-effects its arguments *)
               let (m,p) = List.split (Context_neg.context_neg minus plus) in
               Type_infer.type_infer p;
@@ -1598,6 +1654,8 @@ let process file isofile verbose =
                      some restrictions on the -+ code *)
                   ([],_) | (_,Ast.Generated) -> ([],minus)
                 | _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in
+              (* after iso, because iso can intro ... *)
+              let minus = Adjacency.compute_adjacency minus in
               let minus = Comm_assoc.comm_assoc minus rule_name dropiso in
               let minus =
                 if !Flag.sgrep_mode2 then minus