aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/test/hipe_testsuite_driver.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe/test/hipe_testsuite_driver.erl')
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl182
1 files changed, 182 insertions, 0 deletions
diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl
new file mode 100644
index 0000000000..c8fdf1600c
--- /dev/null
+++ b/lib/hipe/test/hipe_testsuite_driver.erl
@@ -0,0 +1,182 @@
+-module(hipe_testsuite_driver).
+
+-export([create_all_suites/0, run/3]).
+
+-include_lib("kernel/include/file.hrl").
+
+-type testcase() :: atom().
+-type file_type() :: 'device' | 'directory' | 'regular' | 'other'.
+-type ext_posix() :: file:posix() | 'badarg'.
+
+-define(suite_suffix, "_SUITE").
+-define(data_folder, "_data").
+-define(suite_data, ?suite_suffix ++ ?data_folder).
+
+-record(suite, {suitename :: string(),
+ outputfile :: file:io_device(),
+ testcases :: [testcase()]}).
+
+-spec create_all_suites() -> 'ok'.
+
+create_all_suites() ->
+ {ok, Cwd} = file:get_cwd(),
+ Suites = get_suites(Cwd),
+ lists:foreach(fun create_suite/1, Suites).
+
+-spec get_suites(file:filename()) -> [string()].
+
+get_suites(Dir) ->
+ case file:list_dir(Dir) of
+ {error, _} -> [];
+ {ok, Filenames} ->
+ FullFilenames = [filename:join(Dir, F) || F <- Filenames],
+ Dirs = [suffix(filename:basename(F), ?suite_data) ||
+ F <- FullFilenames,
+ file_type(F) =:= {ok, 'directory'}],
+ [S || {yes, S} <- Dirs]
+ end.
+
+suffix(String, Suffix) ->
+ case string:rstr(String, Suffix) of
+ 0 -> no;
+ Index ->
+ case string:substr(String, Index) =:= Suffix of
+ true -> {yes, string:sub_string(String, 1, Index-1)};
+ false -> no
+ end
+ end.
+
+-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}.
+
+file_type(Filename) ->
+ case file:read_file_info(Filename) of
+ {ok, FI} -> {ok, FI#file_info.type};
+ Error -> Error
+ end.
+
+-spec create_suite(string()) -> 'ok'.
+
+create_suite(SuiteName) ->
+ {ok, Cwd} = file:get_cwd(),
+ SuiteDirN = filename:join(Cwd, SuiteName ++ ?suite_data),
+ OutputFile = generate_suite_file(Cwd, SuiteName),
+ generate_suite(SuiteName, OutputFile, SuiteDirN).
+
+generate_suite_file(Cwd, SuiteName) ->
+ F = filename:join(Cwd, SuiteName ++ ?suite_suffix ++ ".erl"),
+ case file:open(F, [write]) of
+ {ok, IoDevice} -> IoDevice;
+ {error, _} = E -> exit({E, F})
+ end.
+
+generate_suite(SuiteName, OutputFile, SuiteDirN) ->
+ TestCases = list_testcases(SuiteDirN),
+ Suite = #suite{suitename = SuiteName, outputfile = OutputFile,
+ testcases = TestCases},
+ write_suite(Suite),
+ file:close(OutputFile).
+
+list_testcases(Dirname) ->
+ {ok, Files} = list_dir(Dirname, ".erl", true),
+ [list_to_atom(filename:basename(F, ".erl")) || F <- Files].
+
+-spec list_dir(file:filename(), string(), boolean()) ->
+ {error, ext_posix()} | {ok, [file:filename()]}.
+
+list_dir(Dir, Extension, Dirs) ->
+ case file:list_dir(Dir) of
+ {error, _} = Error-> Error;
+ {ok, Filenames} ->
+ FullFilenames = [filename:join(Dir, F) || F <- Filenames],
+ Matches1 = case Dirs of
+ true ->
+ [F || F <- FullFilenames,
+ file_type(F) =:= {ok, 'directory'}];
+ false -> []
+ end,
+ Matches2 = [F || F <- FullFilenames,
+ file_type(F) =:= {ok, 'regular'},
+ filename:extension(F) =:= Extension],
+ {ok, lists:sort(Matches1 ++ Matches2)}
+ end.
+
+write_suite(Suite) ->
+ write_header(Suite),
+ write_testcases(Suite).
+
+write_header(#suite{suitename = SuiteName, outputfile = OutputFile,
+ testcases = TestCases}) ->
+ Exports = format_export(TestCases),
+ TimeLimit = 2, %% with 1 it fails on some slow machines...
+ io:format(OutputFile,
+ "%% ATTENTION!\n"
+ "%% This is an automatically generated file. Do not edit.\n\n"
+ "-module(~s).\n\n"
+ "-export([suite/0, init_per_suite/0, init_per_suite/1,\n"
+ " end_per_suite/1, all/0]).\n"
+ "~s\n\n"
+ "-include_lib(\"common_test/include/ct.hrl\").\n\n"
+ "suite() ->\n"
+ " [{timetrap, {minutes, ~w}}].\n\n"
+ "init_per_suite() ->\n"
+ " [].\n\n"
+ "init_per_suite(Config) ->\n"
+ " case erlang:system_info(hipe_architecture) of\n"
+ " undefined -> {skip, \"HiPE not available or enabled\"};\n"
+ " _ -> Config\n"
+ " end.\n\n"
+ "end_per_suite(_Config) ->\n"
+ " ok.\n\n"
+ "all() ->\n"
+ " ~p.\n\n"
+ "test(Config, TestCase) ->\n"
+ " Dir = ?config(data_dir, Config),\n"
+ " OutDir = ?config(priv_dir, Config),\n"
+ " hipe_testsuite_driver:run(TestCase, Dir, OutDir)."
+ "\n\n",
+ [SuiteName ++ ?suite_suffix, Exports, TimeLimit, TestCases]).
+
+format_export(TestCases) ->
+ TL = [list_to_atom(atom_to_list(N)++"/1") || N <- TestCases],
+ TestCaseString = io_lib:format("-export(~p).", [TL]),
+ strip_quotes(lists:flatten(TestCaseString), []).
+
+strip_quotes([], Result) ->
+ lists:reverse(Result);
+strip_quotes([$' |Rest], Result) ->
+ strip_quotes(Rest, Result);
+strip_quotes([$\, |Rest], Result) ->
+ strip_quotes(Rest, [$\ , $\, |Result]);
+strip_quotes([C|Rest], Result) ->
+ strip_quotes(Rest, [C|Result]).
+
+write_testcases(#suite{outputfile = OutputFile, testcases = TestCases}) ->
+ lists:foreach(fun (T) -> write_testcase(OutputFile, T) end, TestCases).
+
+write_testcase(OutputFile, TestCase) ->
+ io:format(OutputFile,
+ "~p(Config) ->\n"
+ " test(Config, ~p).\n\n",
+ [TestCase, TestCase]).
+
+-spec run(atom(), string(), string()) -> 'ok'.
+
+run(TestCase, Dir, _OutDir) ->
+ F = filename:join(Dir, atom_to_list(TestCase) ++ ".erl"),
+ {ok, TestCase} = compile:file(F),
+ ok = try TestCase:prepare_for_test() catch _:_ -> ok end,
+ %% DataFiles = try TestCase:datafiles() catch _:_ -> [] end,
+ %% lists:foreach(fun (DF) ->
+ %% Src = filename:join(Dir, DF),
+ %% Dst = filename:join(OutDir, DF),
+ %% {ok, _} = file:copy(Src, Dst)
+ %% end, DataFiles),
+ %% try
+ ok = TestCase:test(),
+ HiPEOpts = try TestCase:hipe_options() catch _:_ -> [] end,
+ {ok, TestCase} = hipe:c(TestCase, HiPEOpts),
+ ok = TestCase:test().
+ %% after
+ %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end,
+ %% [filename:join(OutDir, D) || D <- DataFiles])
+ %% end.