Add tests for the HiPE compiler (Part 1: binaries and bitstrings)

Create tests for the HiPE native code compiler. This is the first
part of the effort and contains tests that check that the native
code produced by the HiPE compiler for binaries and bitstrings is
OK and behaves similarly to the code produced by the BEAM compiler.

1 files changed, 179 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..72605f9c2f
--- /dev/null
+++ b/lib/hipe/test/hipe_testsuite_driver.erl
@@ -0,0 +1,179 @@
+-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 = 1,
+    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"
+	      "  Config.\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.