X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/785a3008ddade80f642257bb47d43158ac8b8311..9bc82bae75129fec4d981ebf245f2f7d7ca73a41:/cocci.ml

diff --git a/cocci.ml b/cocci.ml
index c8f7910..b2f1ef7 100644
--- a/cocci.ml
+++ b/cocci.ml
@@ -1,3 +1,51 @@
+(*
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * 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.
+ *)
+
+
+(*
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * 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.
+ *)
+
+
 open Common
 
 module CCI = Ctlcocci_integration
@@ -45,13 +93,14 @@ let _hctl = Hashtbl.create 101
 (* --------------------------------------------------------------------- *)
 let sp_of_file2 file iso   =
   Common.memoized _hparse (file, iso) (fun () ->
-    let (_,xs,_,_,_,_,_,_) as res = Parse_cocci.process file iso false in
+    let (_,xs,_,_,_,_,_) as res = Parse_cocci.process file iso false in
     (match Prepare_ocamlcocci.prepare file xs with
       None -> ()
     | Some ocaml_script_file ->
         (* compile file *)
 	Prepare_ocamlcocci.load_file ocaml_script_file;
-	Prepare_ocamlcocci.clean_file ocaml_script_file);
+	if not !Common.save_tmp_files
+	then Prepare_ocamlcocci.clean_file ocaml_script_file);
     res)
 let sp_of_file file iso    =
   Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
@@ -244,24 +293,26 @@ let show_or_not_diff2 cfile outfile =
 	      let diff_line =
 		match List.rev(Str.split (Str.regexp " ") line) with
 		  new_file::old_file::cmdrev ->
+		    let old_base_file = drop_prefix old_file in
 		    if !Flag.sgrep_mode2
 		    then
 		      String.concat " "
-			(List.rev ("/tmp/nothing" :: old_file :: cmdrev))
+			(List.rev
+			   (("/tmp/nothing"^old_base_file)
+			    :: old_file :: cmdrev))
 		    else
-		      let old_base_file = drop_prefix old_file in
 		      String.concat " "
 			(List.rev
 			   (("b"^old_base_file)::("a"^old_base_file)::cmdrev))
 		| _ -> failwith "bad command" in
 	      let (minus_line,plus_line) =
-		if !Flag.sgrep_mode2
-		then (minus_file,"+++ /tmp/nothing")
-		else
-		  match (Str.split (Str.regexp "[ \t]") minus_file,
-			 Str.split (Str.regexp "[ \t]") plus_file) with
-		    ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
-		      let old_base_file = drop_prefix old_file in
+		match (Str.split (Str.regexp "[ \t]") minus_file,
+		       Str.split (Str.regexp "[ \t]") plus_file) with
+		  ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
+		    let old_base_file = drop_prefix old_file in
+		    if !Flag.sgrep_mode2
+		    then (minus_file,"+++ /tmp/nothing"^old_base_file)
+		    else
 		      (String.concat " "
 			 ("---"::("a"^old_base_file)::old_rest),
 		       String.concat " "
@@ -492,7 +543,7 @@ let sp_contain_typed_metavar_z toplevel_list_list =
   let combiner =
     Visitor_ast.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 expression donothing donothing donothing donothing donothing
       donothing donothing donothing donothing donothing
   in
@@ -549,7 +600,9 @@ let (includes_to_parse:
     Flag_cocci.I_UNSPECIFIED -> failwith "not possible"
   | Flag_cocci.I_NO_INCLUDES -> []
   | x ->
-      let all_includes = x =*= Flag_cocci.I_ALL_INCLUDES in
+      let all_includes =
+	List.mem x
+	  [Flag_cocci.I_ALL_INCLUDES; Flag_cocci.I_REALLY_ALL_INCLUDES] in
       xs +> List.map (fun (file, cs) ->
 	let dir = Common.dirname file in
 
@@ -588,7 +641,7 @@ let (includes_to_parse:
 		  )
 	  | _ -> None))
 	+> List.concat
-	+> Common.uniq
+	+> (fun x -> (List.rev (Common.uniq (List.rev x)))) (*uniq keeps last*)
 
 let rec interpret_dependencies local global = function
     Ast_cocci.Dep s      -> List.mem s local
@@ -1010,63 +1063,75 @@ let rebuild_info_c_and_headers ccs isexp =
       rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
   )
 
-
+let rec prepare_h seen env hpath choose_includes : file_info list =
+  if not (Common.lfile_exists hpath)
+  then
+    begin
+      pr2 ("TYPE: header " ^ hpath ^ " not found");
+      []
+    end
+  else
+    begin
+      let h_cs = cprogram_of_file_cached hpath in
+      let local_includes =
+	if choose_includes =*= Flag_cocci.I_REALLY_ALL_INCLUDES
+	then
+	  List.filter
+	    (function x -> not (List.mem x !seen))
+	    (includes_to_parse [(hpath,h_cs)] choose_includes)
+	else [] in
+      seen := local_includes @ !seen;
+      let others =
+	List.concat
+	  (List.map (function x -> prepare_h seen env x choose_includes)
+	     local_includes) in
+      let info_h_cs = build_info_program h_cs !env in
+      env :=
+	if null info_h_cs
+	then !env
+	else last_env_toplevel_c_info info_h_cs;
+      others@
+      [{
+	fname = Common.basename hpath;
+	full_fname = hpath;
+	asts = info_h_cs;
+	was_modified_once = ref false;
+	fpath = hpath;
+	fkind = Header;
+      }]
+    end
 
 let prepare_c files choose_includes : file_info list =
   let cprograms = List.map cprogram_of_file_cached files in
   let includes = includes_to_parse (zip files cprograms) choose_includes in
+  let seen = ref includes in
 
   (* todo?: may not be good to first have all the headers and then all the c *)
-  let all =
-    (includes +> List.map (fun hpath -> Right hpath))
-    ++
-    ((zip files cprograms) +>
-     List.map (fun (file, asts) -> Left (file, asts)))
-  in
-
   let env = ref !TAC.initial_env in
 
-  let ccs = all +> Common.map_filter (fun x ->
-    match x with
-    | Right hpath ->
-        if not (Common.lfile_exists hpath)
-        then begin
-          pr2 ("TYPE: header " ^ hpath ^ " not found");
-          None
-        end
-        else
-          let h_cs = cprogram_of_file_cached hpath in
-          let info_h_cs = build_info_program h_cs !env in
-          env :=
-            if null info_h_cs
-            then !env
-            else last_env_toplevel_c_info info_h_cs
-          ;
-          Some {
-            fname = Common.basename hpath;
-            full_fname = hpath;
-            asts = info_h_cs;
-            was_modified_once = ref false;
-            fpath = hpath;
-            fkind = Header;
-          }
-    | Left (file, cprogram) ->
-        (* todo?: don't update env ? *)
+  let includes =
+    includes +>
+    List.map (function hpath -> prepare_h seen env hpath choose_includes) +>
+    List.concat in
+
+  let cfiles =
+    (zip files cprograms) +>
+    List.map
+      (function (file, cprogram) ->
+      (* todo?: don't update env ? *)
         let cs = build_info_program cprogram !env in
         (* we do that only for the c, not for the h *)
         ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c)));
-        Some {
-          fname = Common.basename file;
-          full_fname = file;
-          asts = cs;
-          was_modified_once = ref false;
-          fpath = file;
-          fkind = Source;
-        }
-  )
-  in
-  ccs
+        {
+        fname = Common.basename file;
+        full_fname = file;
+        asts = cs;
+        was_modified_once = ref false;
+        fpath = file;
+        fkind = Source
+      }) in
 
+  includes @ cfiles
 
 (*****************************************************************************)
 (* Processing the ctls and toplevel C elements *)
@@ -1207,21 +1272,23 @@ let apply_script_rule r cache newes e rules_that_have_matched
 		List.exists (function (_,(r,m),_) -> r =*= re && m =$= rm) mv)
 	      e in
 	  (try
-	    let script_vals =  List.assoc relevant_bindings cache in
-	    print_dependencies
-	      "dependencies for script satisfied, but cached:"
-	      rules_that_have_matched
-	      !rules_that_have_ever_matched
-	      r.scr_rule_info.dependencies;
-	    show_or_not_binding "in" e;
+	    match List.assoc relevant_bindings cache with
+	      None -> (cache,newes)
+	    | Some script_vals ->
+		print_dependencies
+		  "dependencies for script satisfied, but cached:"
+		  rules_that_have_matched
+		  !rules_that_have_ever_matched
+		  r.scr_rule_info.dependencies;
+		show_or_not_binding "in" e;
 	      (* env might be bigger than what was cached against, so have to
 		 merge with newes anyway *)
-	    let new_e = (List.combine script_vars script_vals) @ e in
-	    let new_e =
-	      new_e +>
-	      List.filter
-		(fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
-	    (cache,merge_env [(new_e, rules_that_have_matched)] newes)
+		let new_e = (List.combine script_vars script_vals) @ e in
+		let new_e =
+		  new_e +>
+		  List.filter
+		    (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
+		(cache,merge_env [(new_e, rules_that_have_matched)] newes)
 	  with Not_found ->
 	    begin
 	      print_dependencies "dependencies for script satisfied:"
@@ -1232,7 +1299,7 @@ let apply_script_rule r cache newes e rules_that_have_matched
 	      match script_application mv ve script_vars r with
 		None ->
 		  (* failure means we should drop e, no new bindings *)
-		  (((relevant_bindings,[]) :: cache), newes)
+		  (((relevant_bindings,None) :: cache), newes)
 	      | Some script_vals ->
 		  let script_vals =
 		    List.map (function x -> Ast_c.MetaIdVal(x,[]))
@@ -1244,7 +1311,7 @@ let apply_script_rule r cache newes e rules_that_have_matched
 		    List.filter
 		      (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
 		  r.scr_rule_info.was_matched := true;
-		  (((relevant_bindings,script_vals) :: cache),
+		  (((relevant_bindings,Some script_vals) :: cache),
 		   merge_env
 		     [(new_e,
 		       r.scr_rule_info.rulename :: rules_that_have_matched)]
@@ -1529,7 +1596,8 @@ and process_a_ctl_a_env_a_toplevel2 r e c f =
 
     r.rule_info.was_matched := true;
 
-    if not (null trans_info)
+    if not (null trans_info) &&
+      not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff)
     then begin
       c.was_modified := true;
       try
@@ -1606,7 +1674,7 @@ let rec bigloop2 rs (ccs: file_info list) =
 	then
 	  Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched);
 
-        es := (if newes = [] then init_es else newes);
+        es := newes (*(if newes = [] then init_es else newes)*);
     | CocciRuleCocciInfo r ->
 	apply_cocci_rule r rules_that_have_ever_matched
 	  es ccs);
@@ -1657,8 +1725,8 @@ let initial_final_bigloop2 ty rebuild r =
       let _ = apply_script_rule r [] [] [] [] (ref []) ocaml_application in
       ()
   | _ ->
-      Printf.printf "Unknown language for initial/final script: %s\n"
-	r.language
+      failwith ("Unknown language for initial/final script: "^
+		r.language)
 
 let initial_final_bigloop a b c =
   Common.profile_code "initial_final_bigloop"
@@ -1683,7 +1751,7 @@ let pre_engine2 (coccifile, isofile) =
   (* useful opti when use -dir *)
   let (metavars,astcocci,
        free_var_lists,negated_pos_lists,used_after_lists,
-       positions_lists,toks,_) =
+       positions_lists,(toks,_,_)) =
       sp_of_file coccifile isofile in
   let ctls = ctls_of_ast astcocci used_after_lists positions_lists in