Release coccinelle-0.2.0rc1

[bpt/coccinelle.git] / testing.ml

open Common

(*****************************************************************************)
(* Test framework *)
(*****************************************************************************)

(* There can be multiple .c for the same cocci file. The convention
 * is to have one base.cocci and a base.c and some optional
 * base_vernn.[c,res].
 * 
 * If want to test without iso, use -iso_file empty.iso option.
 *)
let testone x compare_with_expected_flag = 
  let x    = if x =~ "\\(.*\\)_ver0$" then matched1 x else x in
  let base = if x =~ "\\(.*\\)_ver[0-9]+$" then matched1 x else x in

  let cfile      = "tests/" ^ x ^ ".c" in 
  let cocci_file = "tests/" ^ base ^ ".cocci" in

  let expected_res   = "tests/" ^ x ^ ".res" in
  begin
    let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in
    let res = Cocci.full_engine cocci_infos [cfile] in
    Cocci.post_engine cocci_infos;
    let generated = 
      match Common.optionise (fun () -> List.assoc cfile res) with
      | Some (Some outfile) -> 
          if List.length res > 1 
          then pr2 ("note that not just " ^ cfile ^ " was involved");

          let tmpfile = "/tmp/"^Common.basename cfile in
          pr2 (sprintf "One file modified. Result is here: %s" tmpfile);
          Common.command2 ("mv "^outfile^" "^tmpfile);
          tmpfile
      | Some None -> 
          pr2 "no modification on the input file";
          cfile
      | None -> raise Impossible
    in
    if compare_with_expected_flag
    then 
      Compare_c.compare_default generated expected_res 
      +> Compare_c.compare_result_to_string 
      +> pr2;
  end
          

(* ------------------------------------------------------------------------ *)
(* note: if you get some weird results in -testall, and not in -test, 
 * it is possible that a test file work in -test but may not 
 * work while used inside a -testall. If we have some bugs in our
 * parser that modify some global state and that those states 
 * are not reseted between each test file, then having run previous
 * test files may have an influence on another test file which mean
 * than a test may work in isolation (via -test) but not otherwise
 * (via -testall). Fortunately such bugs are rare.
 * 
 *)
let testall ?(expected_score_file="tests/SCORE_expected.sexp") () =
 
  let score  = empty_score () in

  let expected_result_files = 
    Common.glob "tests/*.res" 
    +> List.filter (fun f -> Common.filesize f > 0)
    +> List.map Filename.basename
    +> List.sort compare
  in

  begin
    expected_result_files +> List.iter (fun res -> 
      let x = 
        if res =~ "\\(.*\\).res" then matched1 res else raise Impossible in
      let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in 
      let cfile      = "tests/" ^ x ^ ".c" in
      let cocci_file = "tests/" ^ base ^ ".cocci" in
      let expected = "tests/" ^ res in

      let timeout_testall = 30 in

      try (
        Common.timeout_function timeout_testall  (fun () -> 

	  pr2 res;

	  let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in
          let xs = Cocci.full_engine cocci_infos [cfile] in
	  Cocci.post_engine cocci_infos;

          let generated = 
            match List.assoc cfile xs with
            | Some generated -> generated
            | None -> cfile
          in

          let (correct, diffxs) = Compare_c.compare_default generated expected
          in

          (* I don't use Compare_c.compare_result_to_string because
           * I want to indent a little more the messages.
           *)
          (match correct with
          | Compare_c.Correct -> Hashtbl.add score res Common.Ok;
          | Compare_c.Pb s -> 
              let s = Str.global_replace 
                (Str.regexp "\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
              in
              (* on macos the temporary files are stored elsewhere *)
              let s = Str.global_replace 
                (Str.regexp "\"/var/folders/.*/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
              in
              let s = 
                "INCORRECT:" ^ s ^ "\n" ^ 
                "    diff (result(<) vs expected_result(>)) = \n" ^
                (diffxs +> List.map(fun s -> "    "^s^"\n") +> Common.join "")
              in
              Hashtbl.add score res (Common.Pb s)
          | Compare_c.PbOnlyInNotParsedCorrectly s -> 
              let s = 
                "seems incorrect, but only because of code that " ^
                "was not parsable" ^ s
              in
              Hashtbl.add score res (Common.Pb s)
          )
        )
      )
      with exn -> 
        Common.reset_pr_indent();
        let s = "PROBLEM\n" ^ ("   exn = " ^ Printexc.to_string exn ^ "\n") in
        Hashtbl.add score res (Common.Pb s)
    );


    pr2 "--------------------------------";
    pr2 "statistics";
    pr2 "--------------------------------";

    Common.hash_to_list score +> List.iter (fun (s, v) -> 
      pr_no_nl (Printf.sprintf "%-30s: " s);
      pr_no_nl (
        match v with
        | Common.Ok ->  "CORRECT\n" 
        | Common.Pb s -> s
      )
    );
    flush stdout; flush stderr;

    pr2 "--------------------------------";
    pr2 "regression testing  information";
    pr2 "--------------------------------";
 
    (* now default argument of testall:
    let expected_score_file = "tests/SCORE_expected.sexp" in
    *)
    let expected_score_file_orig = "tests/SCORE_expected_orig.sexp" in
    let best_of_both_file = "tests/SCORE_best_of_both.sexp" in
    let actual_score_file = "tests/SCORE_actual.sexp" in

    pr2 ("regression file: "^ expected_score_file);
    let (expected_score : score) = 
      if Sys.file_exists expected_score_file
      then 
        let sexp = Sexp.load_sexp expected_score_file in
        Sexp_common.score_of_sexp sexp
      else 
        if Sys.file_exists expected_score_file_orig 
        then begin
          pr2 (spf "use expected orig file (%s)" expected_score_file_orig);
          Common.command2 (spf "cp %s %s" expected_score_file_orig 
                                          expected_score_file);
          let sexp = Sexp.load_sexp expected_score_file in
          Sexp_common.score_of_sexp sexp
        end
       else 
          empty_score()
    in

    let new_bestscore = Common.regression_testing_vs score expected_score in


    let xs = Common.hash_to_list score in
    let sexp = Sexp_common.sexp_of_score_list xs in
    let s_score = Sexp.to_string_hum sexp in
    Common.write_file ~file:(actual_score_file) s_score;

    let xs2 = Common.hash_to_list new_bestscore in
    let sexp2 = Sexp_common.sexp_of_score_list xs2 in
    let s_score2 = Sexp.to_string_hum sexp2 in
    Common.write_file ~file:(best_of_both_file) s_score2;

    Common.print_total_score score;

    let (good, total)                   = Common.total_scores score in
    let (expected_good, expected_total) = Common.total_scores expected_score in

    if good = expected_good 
    then begin 
      pr2 "Current score is equal to expected score; everything is fine";
      raise (UnixExit 0);
    end
    else 
      if good < expected_good
      then begin 
        pr2 "Current score is lower than expected :(";
        pr2 (spf "(was expecting %d but got %d)" expected_good good);
        pr2 "";
        pr2 "If you think it's normal, then maybe you need to update the";
        pr2 (spf "score file %s, copying info from %s."
                expected_score_file actual_score_file);
        raise (UnixExit 1);
      end
      else begin
        pr2 "Current score is greater than expected :)";
        pr2 (spf "(was expecting %d but got %d)" expected_good good);
        pr2 "Generating new expected score file and saving old one";
        Common.command2_y_or_no_exit_if_no
          (spf "mv %s %s" expected_score_file (expected_score_file ^ ".save"));
        Common.command2_y_or_no_exit_if_no
          (spf "mv %s %s" best_of_both_file expected_score_file);
        raise (UnixExit 0);
      end
     
  end

(* ------------------------------------------------------------------------ *)

type okfailed = Ok | SpatchOK | Failed

(* test_to_string *)
let t_to_s = function
  | Ok -> ".ok"
  | SpatchOK -> ".spatch_ok"
  | Failed -> ".failed"

let delete_previous_result_files infile = 
  [Ok;SpatchOK;Failed] +> List.iter (fun kind -> 
    Common.command2 ("rm -f " ^ infile ^ t_to_s kind)
  )

(* quite similar to compare_with_expected  below *)
let test_okfailed cocci_file cfiles = 
  cfiles +> List.iter delete_previous_result_files;

  (* final_files contain the name of an output file (a .ok or .failed
   * or .spatch_ok), and also some additionnal strings to be printed in
   * this output file in addition to the general error message of
   * full_engine. *)
  let final_files = ref [] in 


  let newout = 
    Common.new_temp_file "cocci" ".stdout" 
  in

  let t = Unix.gettimeofday () in
  let time_per_file_str () = 
    let t' = Unix.gettimeofday () in
    let tdiff = t' -. t in
    let tperfile = tdiff /. (float_of_int (List.length cfiles)) in
    spf "time: %f" tperfile
  in
  
  Common.redirect_stdout_stderr newout (fun () -> 
    try (
      Common.timeout_function_opt !Flag_cocci.timeout (fun () ->

	let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in
        let outfiles = Cocci.full_engine cocci_infos cfiles in
	Cocci.post_engine cocci_infos;

        let time_str = time_per_file_str () in
          
        outfiles +> List.iter (fun (infile, outopt) -> 
          let (dir, base, ext) = Common.dbe_of_filename infile in
          let expected_suffix   = 
            match ext with
            | "c" -> "res"
            | "h" -> "h.res"
            | s -> pr2 ("WEIRD: not a .c or .h :" ^ base ^ "." ^ s);
                "" (* no extension, will compare to same file *)
          in
          let expected_res =  
            Common.filename_of_dbe  (dir, base, expected_suffix) in
          let expected_res2 = 
            Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) 
          in
	  
            (* can delete more than the first delete_previous_result_files
               * because here we can have more files than in cfiles, for instance
               * the header files
            *)
          delete_previous_result_files infile;
          
          match outopt, Common.lfile_exists expected_res with
          | None, false -> 
              ()
          | Some outfile, false -> 
              let s =("PB: input file " ^ infile ^ " modified but no .res") in
              push2 (infile^t_to_s Failed, [s;time_str]) final_files
		
          | x, true -> 
              let outfile = 
                match x with 
                | Some outfile -> outfile 
                | None -> infile 
              in
              
              let diff = Compare_c.compare_default outfile expected_res in
              let s1 = (Compare_c.compare_result_to_string diff) in
              if fst diff =*= Compare_c.Correct
              then push2 (infile ^ (t_to_s Ok), [s1;time_str]) final_files
              else 
                if Common.lfile_exists expected_res2
                then begin
                  let diff = Compare_c.compare_default outfile expected_res2 in
                  let s2 = Compare_c.compare_result_to_string diff in
                  if fst diff =*= Compare_c.Correct
                  then push2 (infile ^ (t_to_s SpatchOK),[s2;s1;time_str]) 
                      final_files
                  else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str]) 
                      final_files
                end
		else push2 (infile ^ (t_to_s Failed), [s1;time_str]) final_files
		    )
	  );
      )
    with exn -> 
      let clean s =
	Str.global_replace (Str.regexp "\\\\n") "\n"
	  (Str.global_replace (Str.regexp ("\\\\\"")) "\""
	     (Str.global_replace (Str.regexp "\\\\t") "\t" s)) in
      let s = "PROBLEM\n"^("   exn = " ^ clean(Printexc.to_string exn) ^ "\n")
      in
      let time_str = time_per_file_str () 
      in
      (* we may miss some file because cfiles is shorter than outfiles.
	 * For instance the detected local headers are not in cfiles, so
	 * may have less failed. But at least have some failed.
      *)
      cfiles +> List.iter (fun infile -> 
        push2 (infile ^ (t_to_s Failed), [s;time_str]) final_files;
	);
      );
  !final_files +> List.iter (fun (file, additional_strs) -> 
    Common.command2 ("cp " ^ newout ^ " " ^ file);
    with_open_outfile file (fun (pr, chan) -> 
      additional_strs +> List.iter (fun s -> pr (s ^ "\n"))
	);
    
    )


let test_regression_okfailed () = 

  (* it's  xxx.c.ok *)
  let chop_ext f = f +> Filename.chop_extension in

  let newscore  = Common.empty_score () in
  let oks = 
    Common.cmd_to_list ("find -name \"*.ok\"") 
    ++
    Common.cmd_to_list ("find -name \"*.spatch_ok\"")
  in
  let failed = Common.cmd_to_list ("find -name \"*.failed\"") in

  if null (oks ++ failed) 
  then failwith "no ok/failed file, you certainly did a make clean"
  else begin
    oks +> List.iter (fun s -> 
      Hashtbl.add newscore (chop_ext s)  Common.Ok
    );
    failed +> List.iter (fun s -> 
      Hashtbl.add newscore (chop_ext s) (Common.Pb "fail")
    );
    pr2 "--------------------------------";
    pr2 "regression testing  information";
    pr2 "--------------------------------";
    Common.regression_testing newscore ("score_failed.marshalled")
  end
    

(* ------------------------------------------------------------------------ *)
(* quite similar to test_ok_failed. Maybe could factorize code *)
let compare_with_expected outfiles =
  pr2 "";
  outfiles +> List.iter (fun (infile, outopt) -> 
    let (dir, base, ext) = Common.dbe_of_filename infile in
    let expected_suffix   = 
      match ext with
      | "c" -> "res"
      | "h" -> "h.res"
      | s -> failwith ("weird C file, not a .c or .h :" ^ s)
    in
    let expected_res =  
      Common.filename_of_dbe  (dir, base, expected_suffix) in
    let expected_res2 = 
      Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) 
    in
    
    match outopt, Common.lfile_exists expected_res with
    | None, false -> ()
    | Some outfile, false -> 
        let s =("PB: input file " ^ infile ^ " modified but no .res") in
        pr2 s
    | x, true -> 
        let outfile = 
          match x with 
          | Some outfile -> outfile 
          | None -> infile 
        in
        let diff = Compare_c.compare_default outfile expected_res in
        let s1 = (Compare_c.compare_result_to_string diff) in
        if fst diff =*= Compare_c.Correct
        then pr2_no_nl (infile ^ " " ^ s1)
        else 
          if Common.lfile_exists expected_res2
          then begin
            let diff = Compare_c.compare_default outfile expected_res2 in
            let s2 = Compare_c.compare_result_to_string diff in
            if fst diff =*= Compare_c.Correct
            then pr2 (infile ^ " is spatchOK " ^ s2)
            else pr2 (infile ^ " is failed " ^ s2)
          end
        else pr2 (infile ^ " is failed " ^ s1)
  )

(*****************************************************************************)
(* Subsystem testing *)
(*****************************************************************************)

let test_parse_cocci file = 
  if not (file =~ ".*\\.cocci") 
  then pr2 "warning: seems not a .cocci file";

  let (_,xs,_,_,_,_,grep_tokens,query) =
    Parse_cocci.process file (Some !Config.std_iso) false in
  xs +> List.iter Pretty_print_cocci.unparse;
  Printf.printf "grep tokens\n";
  List.iter (function x -> Printf.printf "%s\n" (String.concat " " x))
    grep_tokens;
  match !Flag.scanner with
    Flag.NoScanner -> ()
  | Flag.Glimpse | Flag.Google _ ->
      (match query with
	None -> pr "No query"
      | Some x -> pr (String.concat " || " x))



(*****************************************************************************)
(* to be called by ocaml toplevel, to test. *)
(*****************************************************************************)

(* no point to memoize this one *)
let sp_of_file file iso    = Parse_cocci.process file iso false

(* TODO: Remove
*)

(*
let flows_of_ast astc = 
  astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e)

let one_flow flows = 
  List.hd flows

let one_ctl ctls = List.hd (List.hd ctls)
*)