Skip to content
Browse files

More work on ocamlbuild testsuite.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13177 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 02a1db0 commit 068f44d2cfd7870b7dafd2551588bb908f342010 meyer committed Dec 30, 2012
Showing with 53 additions and 32 deletions.
  1. +19 −10 ocamlbuild/testsuite/level0.ml
  2. +34 −22 ocamlbuild/testsuite/ocamlbuild_test.ml
View
29 ocamlbuild/testsuite/level0.ml
@@ -1,6 +1,8 @@
#use "topfind";;
#require "unix";;
+let ocamlbuild = try Sys.getenv "OCAMLBUILD" with Not_found -> "ocamlbuild";;
+
#use "ocamlbuild_test.ml";;
module M = Match;;
@@ -10,8 +12,8 @@ let _build = M.d "_build";;
test "BasicNativeTree"
~description:"Output tree for native compilation"
- ~tree:(T.f "dummy.ml")
- ~matching:(M.Exact
+ ~tree:[T.f "dummy.ml"]
+ ~matching:[M.Exact
(_build
(M.lf
["_digests";
@@ -22,13 +24,13 @@ test "BasicNativeTree"
"dummy.ml.depends";
"dummy.native";
"dummy.o";
- "_log"])))
+ "_log"]))]
~targets:("dummy.native",[]);;
test "BasicByteTree"
~description:"Output tree for byte compilation"
- ~tree:(T.f "dummy.ml")
- ~matching:(M.Exact
+ ~tree:[T.f "dummy.ml"]
+ ~matching:[M.Exact
(_build
(M.lf
["_digests";
@@ -37,23 +39,30 @@ test "BasicByteTree"
"dummy.ml";
"dummy.ml.depends";
"dummy.byte";
- "_log"])))
+ "_log"]))]
~targets:("dummy.byte",[]);;
test "SeveralTargets"
~description:"Several targets"
- ~tree:(T.f "dummy.ml")
- ~matching:(_build (M.lf ["dummy.byte"; "dummy.native"]))
+ ~tree:[T.f "dummy.ml"]
+ ~matching:[_build (M.lf ["dummy.byte"; "dummy.native"])]
~targets:("dummy.byte",["dummy.native"]);;
let alt_build_dir = "BuIlD2";;
test "BuildDir"
~options:[`build_dir alt_build_dir]
~description:"Different build directory"
- ~tree:(T.f "dummy.ml")
- ~matching:(M.d alt_build_dir (M.lf ["dummy.byte"]))
+ ~tree:[T.f "dummy.ml"]
+ ~matching:[M.d alt_build_dir (M.lf ["dummy.byte"])]
~targets:("dummy.byte",[]);;
+test "camlp4.opt"
+ ~description:"Fixes PR#5652"
+ ~options:[`use_ocamlfind; `package "camlp4.macro";`tags ["camlp4o.opt"; "syntax\\(camp4o\\)"];
+ `ppflag "camlp4o.opt"; `ppflag "-parser"; `ppflag "macro"; `ppflag "-DTEST"]
+ ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"]
+ ~matching:[M.x "dummy.native" ~output:"Hello"]
+ ~targets:("dummy.native",[]);;
run ~root:"_test";;
View
56 ocamlbuild/testsuite/ocamlbuild_test.ml
@@ -1,10 +1,10 @@
(***********************************************************************)
(* *)
-(* OCaml *)
+(* ocamlbuild *)
(* *)
(* Wojciech Meyer *)
(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* Copyright 2012 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
@@ -17,15 +17,23 @@ external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
let print_list ~sep f ppf = function
| [] -> ()
| x :: [] -> f ppf x
-| x :: xs -> f ppf x; sep ppf (); List.iter (f ppf) xs
+| x :: xs -> f ppf x; List.iter (fun x -> sep ppf (); f ppf x) xs
let print_list_com f = print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f
let print_list_blank f = print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f
let print_string_list = print_list_com pp_print_string
let print_string_list_com = print_list_com pp_print_string
let print_string_list_blank = print_list_blank pp_print_string
+let execute cmd =
+ let ic = Unix.open_process_in cmd and lst = ref [] in
+ try while true do lst := input_line ic :: !lst done; assert false
+ with End_of_file ->
+ let ret_code = Unix.close_process_in ic
+ in ret_code, List.rev !lst
+
module Match = struct
+
type atts = unit
(* File consists of file attribute and name *)
@@ -59,6 +67,7 @@ module Match = struct
Expected of string
| Unexpected of string
| Structure of string * string list
+ | Output of string * string
(* This will print the tree *)
let print ppf tree =
@@ -81,14 +90,16 @@ module Match = struct
let f ?(atts=()) name = F (atts, name)
let d ?(atts=()) name children = D ((atts, name), children)
let lf ?(atts=()) lst = List.map (fun nm -> F (atts,nm)) lst
+ let x ?(atts=()) name ~output = X ((atts,name), (0,output))
+
let match_with_fs ~root m =
let errors = ref [] in
let rec visit ~exact path m =
let file name =
- List.rev (name :: path)
- |> String.concat "/"
+ "./" ^ (List.rev (name :: path) |> String.concat "/")
+
in
let exists filename =
@@ -119,6 +130,11 @@ module Match = struct
(if exact && lst' <> [] then
errors := Structure ((file name), lst') :: !errors);
List.iter (visit ~exact (name :: path)) sub
+ | X (((), name), (retcode, output)) ->
+ let _,output' = execute (file name) in
+ let output' = String.concat "\n" output' in
+ if output <> output' then
+ errors := Output (output, output') :: !errors
| Exact sub -> visit ~exact:true path sub
| Contains sub -> visit ~exact:false path sub
| _ -> assert false
@@ -133,7 +149,7 @@ module Match = struct
| Expected s -> Printf.sprintf "expected '%s' on a file system" s
| Unexpected s -> Printf.sprintf "un-expected '%s' on a file system" s
| Structure (s,l) -> Printf.sprintf "directory structure '%s' has un-expected files %s" s (String.concat ", " l)
-
+ | Output (e, p) -> Printf.sprintf "not matching output '%s' expected but got %s" e p
end
module Option = struct
@@ -145,6 +161,7 @@ module Option = struct
type file = string
type command = string
type _module = string
+ type tag = string
type t =
[ `version
@@ -343,6 +360,7 @@ module Tree = struct
Unix.chdir root;
visit [] f;
Unix.chdir dir
+
end
type content = string
@@ -351,8 +369,8 @@ type run = filename * content
type test = { name : string
; description : string
- ; tree : Tree.t
- ; matching : Match.t
+ ; tree : Tree.t list
+ ; matching : Match.t list
; options : Option.t list
; targets : string * string list
; pre_cmd : string option
@@ -370,18 +388,10 @@ let test ?(options=[]) ?(run=[]) ?pre_cmd
let run ~root =
- let execute cmd =
- let ic = Unix.open_process_in cmd and lst = ref [] in
- try while true do lst := input_line ic :: !lst done; assert false
- with End_of_file ->
- let ret_code = Unix.close_process_in ic
- in ret_code, List.rev !lst
- in
-
let command opts args =
let b = Buffer.create 127 in
let f = Format.formatter_of_buffer b in
- fprintf f "ocamlbuild %a %a" (print_list_blank Option.print_opt) opts (print_list_blank pp_print_string) args;
+ fprintf f "%s %a %a" ocamlbuild (print_list_blank Option.print_opt) opts (print_list_blank pp_print_string) args;
Format.pp_print_flush f ();
Buffer.contents b
in
@@ -397,13 +407,15 @@ let run ~root =
; run } =
let dir = Sys.getcwd () in
+
Unix.chdir root;
- Tree.create_on_fs ~root:name tree;
+ List.iter (Tree.create_on_fs ~root:name) tree;
Unix.chdir name;
(match pre_cmd with
| None -> ()
| Some str -> ignore(Sys.command str));
+
let log_name = name ^ ".log" in
let cmd = command options (fst targets :: snd targets) in
@@ -421,9 +433,9 @@ let run ~root =
| _ ->
Unix.chdir dir;
Unix.chdir root;
- let errors = Match.match_with_fs ~root:name matching in
+ let errors = List.concat (List.map (Match.match_with_fs ~root:name) matching) in
begin if errors == [] then
- Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%s\n" name
+ Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n" name description
else begin
let ch = open_out log_name in
output_string ch ("Run '" ^ cmd ^ "'\n");
@@ -434,5 +446,5 @@ let run ~root =
end
end;
Unix.chdir dir)
- in
- List.iter one_test !tests
+
+ in List.iter one_test !tests

0 comments on commit 068f44d

Please sign in to comment.
Something went wrong with that request. Please try again.