aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/test/compile_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/test/compile_SUITE.erl')
-rw-r--r--lib/compiler/test/compile_SUITE.erl162
1 files changed, 117 insertions, 45 deletions
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index e1db99b357..e634f0fcc2 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -31,13 +31,12 @@
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, encrypted_abstr/1,
strict_record/1,
- missing_testheap/1, cover/1, env/1, core/1, asm/1,
+ cover/1, env/1, core/1,
+ core_roundtrip/1, asm/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1
]).
--export([init/3]).
-
suite() -> [{ct_hooks,[ts_install_cth]}].
%% To cover the stripping of 'type' and 'spec' in beam_asm.
@@ -50,7 +49,7 @@ all() ->
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, encrypted_abstr,
strict_record,
- missing_testheap, cover, env, core, asm,
+ cover, env, core, core_roundtrip, asm,
sys_pre_attributes, dialyzer, warnings, pre_load_check].
groups() ->
@@ -545,7 +544,6 @@ verify_abstract(Target) ->
has_crypto() ->
try
crypto:start(),
- <<_,_,_,_,_>> = crypto:rand_bytes(5),
crypto:stop(),
true
catch
@@ -649,46 +647,6 @@ test_sloppy() ->
{1,2} = record_access:test(Turtle),
Turtle.
-missing_testheap(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- PrivDir = proplists:get_value(priv_dir, Config),
- Opts = [{outdir,PrivDir}],
- OldPath = code:get_path(),
- try
- code:add_patha(PrivDir),
- c:c(filename:join(DataDir, "missing_testheap1"), Opts),
- c:c(filename:join(DataDir, "missing_testheap2"), Opts),
- ok = test(fun() ->
- missing_testheap1:f({a,self()},{state,true,b})
- end, {a,b}),
- ok = test(fun() ->
- missing_testheap2:f({a,self()},16#80000000) end,
- bigger)
- after
- code:set_path(OldPath),
- file:delete(filename:join(PrivDir, "missing_testheap1.beam")),
- file:delete(filename:join(PrivDir, "missing_testheap2.beam"))
- end,
- ok.
-
-test(Fun, Result) ->
- test(500, Fun, Result, []).
-
-test(0, _, _, _) ->
- ok;
-test(Iter, Fun, Result, Filler) ->
- spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]),
- receive
- {result, Result} ->
- test(Iter-1, Fun, Result, [0|Filler]);
- {result, Other} ->
- io:format("Expected ~p; got ~p~n", [Result, Other]),
- ct:fail(failed)
- end.
-
-init(ReplyTo, Fun, _Filler) ->
- ReplyTo ! {result, Fun()}.
-
env(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, env),
{ok,Cwd} = file:get_cwd(),
@@ -790,6 +748,120 @@ compile_forms(Forms, Opts) ->
Other -> throw({error,Other})
end.
+%% Pretty-print core and read it back. Should be identical.
+
+core_roundtrip(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)),
+ ok = file:make_dir(Outdir),
+
+ Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
+ TestBeams = filelib:wildcard(Wc),
+ test_lib:p_run(fun(F) -> do_core_roundtrip(F, Outdir) end, TestBeams).
+
+do_core_roundtrip(Beam, Outdir) ->
+ try
+ {ok,{Mod,[{abstract_code,{raw_abstract_v1,Abstr}}]}} =
+ beam_lib:chunks(Beam, [abstract_code]),
+ do_core_roundtrip_1(Mod, Abstr, Outdir)
+ catch
+ throw:{error,Error} ->
+ io:format("*** compilation failure '~p' for file ~s\n",
+ [Error,Beam]),
+ error;
+ Class:Error ->
+ io:format("~p: ~p ~p\n~p\n",
+ [Beam,Class,Error,erlang:get_stacktrace()]),
+ error
+ end.
+
+do_core_roundtrip_1(Mod, Abstr, Outdir) ->
+ {ok,Mod,Core0} = compile:forms(Abstr, [to_core0]),
+ do_core_roundtrip_2(Mod, Core0, Outdir),
+
+ %% Primarily, test that annotations are accepted for all
+ %% constructs. Secondarily, smoke test cerl_trees:label/1.
+ {Core,_} = cerl_trees:label(Core0),
+ do_core_roundtrip_2(Mod, Core, Outdir).
+
+do_core_roundtrip_2(M, Core0, Outdir) ->
+ CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
+ CorePP = core_pp:format_all(Core0),
+ ok = file:write_file(CoreFile, CorePP),
+
+ %% Parse the .core file and return the result as Core Erlang Terms.
+ Core2 = case compile:file(CoreFile, [report_errors,from_core,
+ no_copt,to_core,binary]) of
+ {ok,M,Core1} -> Core1;
+ Other -> throw({error,Other})
+ end,
+ Core = undo_var_translation(Core2),
+ ok = file:delete(CoreFile),
+
+ case cmp_core(Core0, Core, M) of
+ true -> ok;
+ false -> error
+ end,
+
+ ok.
+
+undo_var_translation(Tree) ->
+ F = fun(Node) ->
+ case cerl:is_c_var(Node) of
+ true ->
+ Name0 = cerl:var_name(Node),
+ try atom_to_list(Name0) of
+ "_X"++Name ->
+ cerl:update_c_var(Node, list_to_atom(Name));
+ "_"++Name ->
+ cerl:update_c_var(Node, list_to_atom(Name));
+ _ ->
+ Node
+ catch
+ error:badarg ->
+ Node
+
+ end;
+ false ->
+ Node
+ end
+ end,
+ cerl_trees:map(F, Tree).
+
+cmp_core(E, E, _Mod) ->
+ true;
+cmp_core(M1, M2, Mod) ->
+ cmp_core_fs(cerl:module_defs(M1), cerl:module_defs(M2), Mod).
+
+cmp_core_fs([F1|T1], [F2|T2], Mod) ->
+ cmp_core_f(F1, F2, Mod) andalso cmp_core_fs(T1, T2, Mod);
+cmp_core_fs([], [], _Mod) ->
+ true;
+cmp_core_fs(_, _, _Mod) ->
+ false.
+
+cmp_core_f(E, E, _Mod) ->
+ true;
+cmp_core_f({Name,F1}, {Name,F2}, Mod) ->
+ case diff(F1, F2) of
+ F1 ->
+ true;
+ Diff ->
+ io:format("~p ~p:\n~p\n", [Mod,Name,Diff]),
+ false
+ end.
+
+diff(E, E) ->
+ E;
+diff([H1|T1], [H2|T2]) ->
+ [diff(H1, H2)|diff(T1, T2)];
+diff(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
+ L = diff(tuple_to_list(T1), tuple_to_list(T2)),
+ list_to_tuple(L);
+diff(E1, E2) ->
+ {'DIFF',E1,E2}.
+
+
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.