diff options
Diffstat (limited to 'lib/compiler/test/compile_SUITE.erl')
| -rw-r--r-- | lib/compiler/test/compile_SUITE.erl | 1298 |
1 files changed, 933 insertions, 365 deletions
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index df401ccc2b..96897d612d 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,19 +21,23 @@ %% Tests compile:file/1 and compile:file/2 with various options. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/erl_compile.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, app_test/1,appup_test/1, + debug_info/4, custom_debug_info/1, file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, - other_output/1, encrypted_abstr/1, - bad_record_use1/1, bad_record_use2/1, strict_record/1, - missing_testheap/1, cover/1, env/1, core/1, asm/1, - sys_pre_attributes/1, dialyzer/1]). - --export([init/3]). + other_output/1, kernel_listing/1, encrypted_abstr/1, + strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, + cover/1, env/1, core_pp/1, + core_roundtrip/1, asm/1, optimized_guards/1, + sys_pre_attributes/1, dialyzer/1, + warnings/1, pre_load_check/1, env_compiler_options/1, + bc_options/1 + ]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -45,14 +49,14 @@ all() -> test_lib:recompile(?MODULE), [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, - other_output, encrypted_abstr, - {group, bad_record_use}, strict_record, - missing_testheap, cover, env, core, asm, - sys_pre_attributes, dialyzer]. + other_output, kernel_listing, encrypted_abstr, + strict_record, utf8_atoms, utf8_functions, extra_chunks, + cover, env, core_pp, core_roundtrip, asm, optimized_guards, + sys_pre_attributes, dialyzer, warnings, pre_load_check, + env_compiler_options, custom_debug_info, bc_options]. groups() -> - [{bad_record_use, [], - [bad_record_use1, bad_record_use2]}]. + []. init_per_suite(Config) -> Config. @@ -70,71 +74,130 @@ end_per_group(_GroupName, Config) -> %% Test that the Application file has no `basic' errors."; app_test(Config) when is_list(Config) -> - ?line ?t:app_test(compiler). + test_server:app_test(compiler). %% Test that the Application upgrade file has no `basic' errors."; appup_test(Config) when is_list(Config) -> - ok = ?t:appup_test(compiler). + ok = test_server:appup_test(compiler). %% Tests that we can compile and run a simple Erlang program, %% using compile:file/1. file_1(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(5)), - process_flag(trap_exit, true), - ?line {Simple, Target} = files(Config, "file_1"), - ?line {ok, Cwd} = file:get_cwd(), - ?line ok = file:set_cwd(filename:dirname(Target)), + {Simple, Target} = get_files(Config, simple, "file_1"), + {ok, Cwd} = file:get_cwd(), + ok = file:set_cwd(filename:dirname(Target)), %% Native from BEAM without compilation info. - ?line {ok,simple} = compile:file(Simple, [slim]), %Smoke test only. - ?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. + {ok,simple} = compile:file(Simple, [slim]), %Smoke test only. + {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. %% Native from BEAM with compilation info. - ?line {ok,simple} = compile:file(Simple), %Smoke test only. - ?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. + {ok,simple} = compile:file(Simple), %Smoke test only. + {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. - ?line {ok,simple} = compile:file(Simple, [native,report]), %Smoke test. + {ok,simple} = compile:file(Simple, [native,report]), %Smoke test. - ?line compile_and_verify(Simple, Target, []), - ?line compile_and_verify(Simple, Target, [native]), - ?line compile_and_verify(Simple, Target, [debug_info]), - ?line {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage + compile_and_verify(Simple, Target, []), + compile_and_verify(Simple, Target, [native]), + compile_and_verify(Simple, Target, [debug_info]), + {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage {ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage - ?line ok = file:set_cwd(Cwd), - ?line true = exists(Target), - ?line passed = run(Target, test, []), + + %% Test option 'deterministic'. + {ok,simple} = compile:file(Simple, [deterministic]), + {module,simple} = c:l(simple), + [{version,_}] = simple:module_info(compile), + true = code:delete(simple), + false = code:purge(simple), + + ok = file:set_cwd(Cwd), + true = exists(Target), + passed = run(Target, test, []), + + %% Test option 'deterministic' as a compiler attribute. + Det = deterministic_module, + {DetPath, DetTarget} = get_files(Config, Det, "det_target"), + {ok,Det,DetCode} = compile:file(DetPath, [binary]), + {module,Det} = code:load_binary(Det, "", DetCode), + [{version,_}] = Det:module_info(compile), + true = code:delete(Det), + false = code:purge(Det), %% Cleanup. - ?line ok = file:delete(Target), - ?line ok = file:del_dir(filename:dirname(Target)), + ok = file:delete(Target), + ok = file:del_dir(filename:dirname(Target)), + ok = file:del_dir(filename:dirname(DetTarget)), %% There should not be any messages in the messages. receive Any -> - ?t:fail({unexpected,Any}) + ct:fail({unexpected,Any}) after 10 -> ok end, - ?line test_server:timetrap_cancel(Dog), ok. forms_2(Config) when is_list(Config) -> Src = "/foo/bar", AbsSrc = filename:absname(Src), Anno = erl_anno:new(1), - {ok,simple,Binary} = compile:forms([{attribute,Anno,module,simple}], - [binary,{source,Src}]), - code:load_binary(simple, Src, Binary), - Info = simple:module_info(compile), + SimpleCode = [{attribute,Anno,module,simple}], + {ok,simple,Bin1} = compile:forms(SimpleCode, [binary,{source,Src}]), + + %% Load and test that the proper source is returned. + AbsSrc = forms_load_code(simple, Src, Bin1), + + %% Work in a deleted directory. + PrivDir = proplists:get_value(priv_dir, Config), + WorkDir = filename:join(PrivDir, ?FUNCTION_NAME), + ok = file:make_dir(WorkDir), + ok = file:set_cwd(WorkDir), + case os:type() of + {unix,_} -> os:cmd("rm -rf " ++ WorkDir); + _ -> ok + end, + {ok,simple,Bin2} = compile:forms(SimpleCode), + undefined = forms_load_code(simple, "ignore", Bin2), + + {ok,simple,Bin3} = compile:forms(SimpleCode, [{source,Src},report]), + case forms_load_code(simple, "ignore", Bin3) of + Src -> %Unix. + ok; + AbsSrc -> %Windows. + ok + end, - %% Test that the proper source is returned. - AbsSrc = proplists:get_value(source, Info), + {ok,simple,Core} = compile:forms(SimpleCode, [to_core0,binary]), + forms_compile_and_load(Core, [from_core]), + forms_compile_and_load(Core, [from_core,native]), + + {ok,simple,Asm} = compile:forms(SimpleCode, [to_asm,binary]), + forms_compile_and_load(Asm, [from_asm]), + forms_compile_and_load(Asm, [from_asm,native]), + + {ok,simple,Beam} = compile:forms(SimpleCode, []), + forms_compile_and_load(Beam, [from_beam]), + forms_compile_and_load(Beam, [from_beam,native]), + + %% Cover the error handling code. + error = compile:forms(bad_core, [from_core,report]), + error = compile:forms(bad_asm, [from_asm,report]), + error = compile:forms(<<"bad_beam">>, [from_beam,report]), + error = compile:forms(<<"bad_beam">>, [from_beam,native,report]), + + ok. + + +forms_load_code(Mod, Src, Bin) -> + {module,Mod} = code:load_binary(Mod, Src, Bin), + Info = Mod:module_info(compile), + SourceOption = proplists:get_value(source, Info), %% Ensure that the options are not polluted with 'source'. [] = proplists:get_value(options, Info), @@ -142,124 +205,123 @@ forms_2(Config) when is_list(Config) -> %% Cleanup. true = code:delete(simple), false = code:purge(simple), + + SourceOption. + +forms_compile_and_load(Code, Opts) -> + Mod = simple, + {ok,Mod,Bin} = compile:forms(Code, Opts), + {module,Mod} = code:load_binary(Mod, "ignore", Bin), + _ = Mod:module_info(), + true = code:delete(simple), + false = code:purge(simple), ok. module_mismatch(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line File = filename:join(DataDir, "wrong_module_name.erl"), + DataDir = proplists:get_value(data_dir, Config), + File = filename:join(DataDir, "wrong_module_name.erl"), {error,[{"wrong_module_name.beam", [{none,compile,{module_name,arne,"wrong_module_name"}}]}], []} = compile:file(File, [return]), - ?line error = compile:file(File, [report]), + error = compile:file(File, [report]), - ?line {ok,arne,[]} = compile:file(File, + {ok,arne,[]} = compile:file(File, [return,no_error_module_mismatch]), ok. big_file(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, "big.erl"), - ?line Target = filename:join(PrivDir, "big.beam"), - ?line ok = file:set_cwd(PrivDir), - ?line compile_and_verify(Big, Target, []), - ?line compile_and_verify(Big, Target, [debug_info]), - ?line compile_and_verify(Big, Target, [no_postopt]), + {Big,Target} = get_files(Config, big, "big_file"), + ok = file:set_cwd(filename:dirname(Target)), + compile_and_verify(Big, Target, []), + compile_and_verify(Big, Target, [debug_info]), + compile_and_verify(Big, Target, [no_postopt]), %% Cleanup. - ?line ok = file:delete(Target), - ?line test_server:timetrap_cancel(Dog), + ok = file:delete(Target), ok. %% Tests that the {outdir, Dir} option works. outdir(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "outdir"), - ?line {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]), - ?line true = exists(Target), - ?line passed = run(Target, test, []), - ?line ok = file:delete(Target), - ?line ok = file:del_dir(filename:dirname(Target)), - ?line test_server:timetrap_cancel(Dog), + {Simple, Target} = get_files(Config, simple, "outdir"), + {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]), + true = exists(Target), + passed = run(Target, test, []), + ok = file:delete(Target), + ok = file:del_dir(filename:dirname(Target)), ok. %% Tests that the binary option works. binary(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "binary"), - ?line {ok, simple, Binary} = compile:file(Simple, [binary]), - ?line code:load_binary(simple, Target, Binary), - ?line passed = simple:test(), - ?line true = code:delete(simple), - ?line false = code:purge(simple), - ?line ok = file:del_dir(filename:dirname(Target)), - ?line test_server:timetrap_cancel(Dog), + {Simple, Target} = get_files(Config, simple, "binary"), + {ok, simple, Binary} = compile:file(Simple, [binary]), + code:load_binary(simple, Target, Binary), + passed = simple:test(), + true = code:delete(simple), + false = code:purge(simple), + ok = file:del_dir(filename:dirname(Target)), ok. %% Tests that the dependencies-Makefile-related options work. makedep(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple,Target} = files(Config, "makedep"), - ?line DataDir = ?config(data_dir, Config), - ?line SimpleRootname = filename:rootname(Simple), - ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), - ?line IncludeOptions = [ - {d,need_foo}, - {d,foo_value,42}, - {d,include_generated}, - {i,IncludeDir} - ], + {Simple,Target} = get_files(Config, simple, "makedep"), + DataDir = proplists:get_value(data_dir, Config), + SimpleRootname = filename:rootname(Simple), + IncludeDir = filename:join(filename:dirname(Simple), "include"), + IncludeOptions = [ + {d,need_foo}, + {d,foo_value,42}, + {d,include_generated}, + {i,IncludeDir} + ], %% Basic rule. - ?line BasicMf1Name = SimpleRootname ++ "-basic1.mk", - ?line {ok,BasicMf1} = file:read_file(BasicMf1Name), - ?line {ok,_,Mf1} = compile:file(Simple, [binary,makedep]), - ?line BasicMf1 = makedep_canonicalize_result(Mf1, DataDir), + BasicMf1Name = SimpleRootname ++ "-basic1.mk", + {ok,BasicMf1} = file:read_file(BasicMf1Name), + {ok,_,Mf1} = compile:file(Simple, [binary,makedep]), + BasicMf1 = makedep_canonicalize_result(Mf1, DataDir), %% Basic rule with one existing header. - ?line BasicMf2Name = SimpleRootname ++ "-basic2.mk", - ?line {ok,BasicMf2} = file:read_file(BasicMf2Name), - ?line {ok,_,Mf2} = compile:file(Simple, [binary,makedep|IncludeOptions]), - ?line BasicMf2 = makedep_canonicalize_result(Mf2, DataDir), + BasicMf2Name = SimpleRootname ++ "-basic2.mk", + {ok,BasicMf2} = file:read_file(BasicMf2Name), + {ok,_,Mf2} = compile:file(Simple, [binary,makedep|IncludeOptions]), + BasicMf2 = makedep_canonicalize_result(Mf2, DataDir), %% Rule with one existing header and one missing header. - ?line MissingMfName = SimpleRootname ++ "-missing.mk", - ?line {ok,MissingMf} = file:read_file(MissingMfName), - ?line {ok,_,Mf3} = compile:file(Simple, + MissingMfName = SimpleRootname ++ "-missing.mk", + {ok,MissingMf} = file:read_file(MissingMfName), + {ok,_,Mf3} = compile:file(Simple, [binary,makedep,makedep_add_missing|IncludeOptions]), - ?line MissingMf = makedep_canonicalize_result(Mf3, DataDir), + MissingMf = makedep_canonicalize_result(Mf3, DataDir), %% Rule with modified target. - ?line TargetMf1Name = SimpleRootname ++ "-target1.mk", - ?line {ok,TargetMf1} = file:read_file(TargetMf1Name), - ?line {ok,_,Mf4} = compile:file(Simple, + TargetMf1Name = SimpleRootname ++ "-target1.mk", + {ok,TargetMf1} = file:read_file(TargetMf1Name), + {ok,_,Mf4} = compile:file(Simple, [binary,makedep,{makedep_target,"$target"}|IncludeOptions]), - ?line TargetMf1 = makedep_modify_target( + TargetMf1 = makedep_modify_target( makedep_canonicalize_result(Mf4, DataDir), "$$target"), %% Rule with quoted modified target. - ?line TargetMf2Name = SimpleRootname ++ "-target2.mk", - ?line {ok,TargetMf2} = file:read_file(TargetMf2Name), - ?line {ok,_,Mf5} = compile:file(Simple, + TargetMf2Name = SimpleRootname ++ "-target2.mk", + {ok,TargetMf2} = file:read_file(TargetMf2Name), + {ok,_,Mf5} = compile:file(Simple, [binary,makedep,{makedep_target,"$target"},makedep_quote_target| IncludeOptions]), - ?line TargetMf2 = makedep_modify_target( + TargetMf2 = makedep_modify_target( makedep_canonicalize_result(Mf5, DataDir), "$$target"), %% Basic rule written to some file. - ?line {ok,_} = compile:file(Simple, + {ok,_} = compile:file(Simple, [makedep,{makedep_output,Target}|IncludeOptions]), - ?line {ok,Mf6} = file:read_file(Target), - ?line BasicMf2 = makedep_canonicalize_result(Mf6, DataDir), + {ok,Mf6} = file:read_file(Target), + BasicMf2 = makedep_canonicalize_result(Mf6, DataDir), %% Rule with creating phony target. - ?line PhonyMfName = SimpleRootname ++ "-phony.mk", - ?line {ok,PhonyMf} = file:read_file(PhonyMfName), - ?line {ok,_,Mf7} = compile:file(Simple, + PhonyMfName = SimpleRootname ++ "-phony.mk", + {ok,PhonyMf} = file:read_file(PhonyMfName), + {ok,_,Mf7} = compile:file(Simple, [binary,makedep,makedep_phony|IncludeOptions]), - ?line PhonyMf = makedep_canonicalize_result(Mf7, DataDir), + PhonyMf = makedep_canonicalize_result(Mf7, DataDir), - ?line ok = file:delete(Target), - ?line ok = file:del_dir(filename:dirname(Target)), - ?line test_server:timetrap_cancel(Dog), + ok = file:delete(Target), + ok = file:del_dir(filename:dirname(Target)), ok. makedep_canonicalize_result(Mf, DataDir) -> @@ -279,30 +341,26 @@ makedep_modify_target(Mf, Target) -> %% Tests that conditional compilation, defining values, including files work. cond_and_ifdef(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "cond_and_ifdef"), - ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), - ?line Options = [{outdir, filename:dirname(Target)}, + {Simple, Target} = get_files(Config, simple, "cond_and_ifdef"), + IncludeDir = filename:join(filename:dirname(Simple), "include"), + Options = [{outdir, filename:dirname(Target)}, {d, need_foo}, {d, foo_value, 42}, {i, IncludeDir}, report], - ?line {ok, simple} = compile:file(Simple, Options), - ?line true = exists(Target), - ?line {hiker, 42} = run(Target, foo, []), - ?line ok = file:delete(Target), - ?line ok = file:del_dir(filename:dirname(Target)), - ?line test_server:timetrap_cancel(Dog), + {ok, simple} = compile:file(Simple, Options), + true = exists(Target), + {hiker, 42} = run(Target, foo, []), + ok = file:delete(Target), + ok = file:del_dir(filename:dirname(Target)), ok. listings(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(8)), - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ok = do_file_listings(DataDir, PrivDir, [ "simple", "small", "small_maps" ]), - test_server:timetrap_cancel(Dog), ok. do_file_listings(_, _, []) -> ok; @@ -323,12 +381,14 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dinline, ".inline"), do_listing(Simple, TargetDir, dcore, ".core"), do_listing(Simple, TargetDir, dcopt, ".copt"), + do_listing(Simple, TargetDir, dcbsm, ".core_bsm"), do_listing(Simple, TargetDir, dsetel, ".dsetel"), do_listing(Simple, TargetDir, dkern, ".kernel"), do_listing(Simple, TargetDir, dlife, ".life"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), - do_listing(Simple, TargetDir, dbool, ".bool"), + do_listing(Simple, TargetDir, dexcept, ".except"), + do_listing(Simple, TargetDir, dbs, ".bs"), do_listing(Simple, TargetDir, dtype, ".type"), do_listing(Simple, TargetDir, ddead, ".dead"), do_listing(Simple, TargetDir, djmp, ".jump"), @@ -348,6 +408,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> ok = file:delete(filename:join(Listings, File ++ ".core")), do_listing(Simple, TargetDir, to_core, ".core"), do_listing(Simple, TargetDir, to_kernel, ".kernel"), + do_listing(Simple, TargetDir, to_dis, ".dis"), %% Final clean up. lists:foreach(fun(F) -> ok = file:delete(F) end, @@ -357,159 +418,180 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_file_listings(DataDir,PrivDir,Files). listings_big(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, big), - ?line TargetDir = filename:join(PrivDir, listings_big), - ?line ok = file:make_dir(TargetDir), - ?line do_listing(Big, TargetDir, 'S'), - ?line do_listing(Big, TargetDir, 'E'), - ?line do_listing(Big, TargetDir, 'P'), - ?line do_listing(Big, TargetDir, dkern, ".kernel"), - - ?line Target = filename:join(TargetDir, big), - {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), + {Big,Target} = get_files(Config, big, listings_big), + TargetDir = filename:dirname(Target), + do_listing(Big, TargetDir, 'S'), + do_listing(Big, TargetDir, 'E'), + do_listing(Big, TargetDir, 'P'), + do_listing(Big, TargetDir, dkern, ".kernel"), + do_listing(Big, TargetDir, to_dis, ".dis"), + + TargetNoext = filename:rootname(Target, code:objfile_extension()), + {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), %% Cleanup. - ?line ok = file:delete(Target ++ ".beam"), - ?line lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(TargetDir, "*"))), - ?line ok = file:del_dir(TargetDir), - ?line test_server:timetrap_cancel(Dog), + ok = file:delete(Target), + lists:foreach(fun(F) -> ok = file:delete(F) end, + filelib:wildcard(filename:join(TargetDir, "*"))), + ok = file:del_dir(TargetDir), ok. other_output(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(8)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, simple), - ?line TargetDir = filename:join(PrivDir, other_output), - ?line ok = file:make_dir(TargetDir), + {Simple,_Target} = get_files(Config, simple, "other_output"), io:put_chars("to_pp"), - ?line {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]), - ?line [] = [E || E <- PP, - begin - case element(1, E) of - attribute -> false; - function -> false; - eof -> false - end - end], + {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]), + [] = [E || E <- PP, + begin + case element(1, E) of + attribute -> false; + function -> false; + eof -> false + end + end], io:put_chars("to_exp (file)"), - ?line {ok,simple,Expand} = compile:file(Simple, [to_exp,binary,time]), - ?line case Expand of - {simple,Exports,Forms} when is_list(Exports), is_list(Forms) -> ok - end, + {ok,[],Expand} = compile:file(Simple, [to_exp,binary,time]), + true = is_list(Expand), + {attribute,_,module,simple} = lists:keyfind(module, 3, Expand), io:put_chars("to_exp (forms)"), - ?line {ok,simple,Expand} = compile:forms(PP, [to_exp,binary,time]), + {ok,[],Expand} = compile:forms(PP, [to_exp,binary,time]), io:put_chars("to_core (file)"), - ?line {ok,simple,Core} = compile:file(Simple, [to_core,binary,time]), - ?line c_module = element(1, Core), - ?line {ok,_} = core_lint:module(Core), + {ok,simple,Core} = compile:file(Simple, [to_core,binary,time]), + c_module = element(1, Core), + {ok,_} = core_lint:module(Core), io:put_chars("to_core (forms)"), - ?line {ok,simple,Core} = compile:forms(PP, [to_core,binary,time]), + {ok,simple,Core} = compile:forms(PP, [to_core,binary,time]), io:put_chars("to_kernel (file)"), - ?line {ok,simple,Kernel} = compile:file(Simple, [to_kernel,binary,time]), - ?line k_mdef = element(1, Kernel), + {ok,simple,Kernel} = compile:file(Simple, [to_kernel,binary,time]), + k_mdef = element(1, Kernel), io:put_chars("to_kernel (forms)"), - ?line {ok,simple,Kernel} = compile:forms(PP, [to_kernel,binary,time]), + {ok,simple,Kernel} = compile:forms(PP, [to_kernel,binary,time]), io:put_chars("to_asm (file)"), - ?line {ok,simple,Asm} = compile:file(Simple, [to_asm,binary,time]), - ?line {simple,_,_,_,_} = Asm, + {ok,simple,Asm} = compile:file(Simple, [to_asm,binary,time]), + {simple,_,_,_,_} = Asm, io:put_chars("to_asm (forms)"), - ?line {ok,simple,Asm} = compile:forms(PP, [to_asm,binary,time]), + {ok,simple,Asm} = compile:forms(PP, [to_asm,binary,time]), - ?line test_server:timetrap_cancel(Dog), ok. +%% Smoke test and cover of pretty-printing of Kernel code. +kernel_listing(_Config) -> + TestBeams = get_unique_beam_files(), + Abstr = [begin {ok,{Mod,[{abstract_code, + {raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + {Mod,Abstr} end || Beam <- TestBeams], + test_lib:p_run(fun(F) -> do_kernel_listing(F) end, Abstr). + +do_kernel_listing({M,A}) -> + try + {ok,M,Kern} = compile:forms(A, [to_kernel]), + IoList = v3_kernel_pp:format(Kern), + case unicode:characters_to_binary(IoList) of + Bin when is_binary(Bin) -> + ok + end + catch + throw:{error,Error} -> + io:format("*** compilation failure '~p' for module ~s\n", + [Error,M]), + error; + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [M,Class,Error,erlang:get_stacktrace()]), + error + end. + encrypted_abstr(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line {Simple,Target} = files(Config, "encrypted_abstr"), + {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), Res = case has_crypto() of false -> %% No crypto. - ?line encrypted_abstr_no_crypto(Simple, Target), + encrypted_abstr_no_crypto(Simple, Target), {comment,"The crypto application is missing or broken"}; true -> %% Simulate not having crypto by removing %% the crypto application from the path. - ?line OldPath = code:get_path(), + OldPath = code:get_path(), try - ?line NewPath = OldPath -- [filename:dirname(code:which(crypto))], - ?line (catch crypto:stop()), - ?line code:delete(crypto), - ?line code:purge(crypto), - ?line code:set_path(NewPath), - ?line encrypted_abstr_no_crypto(Simple, Target) + NewPath = OldPath -- [filename:dirname(code:which(crypto))], + (catch crypto:stop()), + code:delete(crypto), + code:purge(crypto), + code:set_path(NewPath), + encrypted_abstr_no_crypto(Simple, Target) after code:set_path(OldPath) end, %% Now run the tests that require crypto. - ?line encrypted_abstr_1(Simple, Target), - ?line ok = file:delete(Target), - ?line ok = file:del_dir(filename:dirname(Target)) + encrypted_abstr_1(Simple, Target), + ok = file:delete(Target), + ok = file:del_dir(filename:dirname(Target)) end, %% Cleanup. - ?line test_server:timetrap_cancel(Dog), Res. encrypted_abstr_1(Simple, Target) -> - ?line TargetDir = filename:dirname(Target), - ?line Key = "ablurf123BX#$;3", - ?line install_crypto_key(Key), - ?line {ok,simple} = compile:file(Simple, + TargetDir = filename:dirname(Target), + Key = "ablurf123BX#$;3", + install_crypto_key(Key), + {ok,simple} = compile:file(Simple, [debug_info,{debug_info_key,Key}, {outdir,TargetDir}]), - ?line verify_abstract(Target), + verify_abstract(Target, erl_abstract_code), - ?line {ok,simple} = compile:file(Simple, + {ok,simple} = compile:file(Simple, [{debug_info_key,Key}, {outdir,TargetDir}]), - ?line verify_abstract(Target), + verify_abstract(Target, erl_abstract_code), - ?line {ok,simple} = compile:file(Simple, + {ok,simple} = compile:file(Simple, [debug_info,{debug_info_key,{des3_cbc,Key}}, {outdir,TargetDir}]), - ?line verify_abstract(Target), + verify_abstract(Target, erl_abstract_code), + + {ok,simple} = compile:file(Simple, + [{debug_info,{?MODULE,ok}}, + {debug_info_key,Key}, + {outdir,TargetDir}]), + verify_abstract(Target, ?MODULE), - ?line {ok,{simple,[{compile_info,CInfo}]}} = + {ok,{simple,[{compile_info,CInfo}]}} = beam_lib:chunks(Target, [compile_info]), - ?line {value,{_,Opts}} = lists:keysearch(options, 1, CInfo), - ?line {value,{_,'********'}} = lists:keysearch(debug_info_key, 1, Opts), + {_,Opts} = lists:keyfind(options, 1, CInfo), + {_,'********'} = lists:keyfind(debug_info_key, 1, Opts), %% Try some illegal forms of crypto keys. - ?line error = compile:file(Simple, + error = compile:file(Simple, [debug_info,{debug_info_key,{blurf,"ss"}},report]), - ?line error = compile:file(Simple, + error = compile:file(Simple, [debug_info,{debug_info_key,{blurf,1,"ss"}},report]), - ?line error = compile:file(Simple, + error = compile:file(Simple, [debug_info,{debug_info_key,42},report]), %% Place the crypto key in .erlang.crypt. - ?line beam_lib:clear_crypto_key_fun(), - ?line {ok,OldCwd} = file:get_cwd(), - ?line ok = file:set_cwd(TargetDir), - - ?line error = compile:file(Simple, [encrypt_debug_info,report]), - - ?line NewKey = "better use another key here", - ?line write_crypt_file(["[{debug_info,des3_cbc,simple,\"",NewKey,"\"}].\n"]), - ?line {ok,simple} = compile:file(Simple, [encrypt_debug_info,report]), - ?line verify_abstract("simple.beam"), - ?line ok = file:delete(".erlang.crypt"), - ?line beam_lib:clear_crypto_key_fun(), - ?line {error,beam_lib,{key_missing_or_invalid,"simple.beam",abstract_code}} = + beam_lib:clear_crypto_key_fun(), + {ok,OldCwd} = file:get_cwd(), + ok = file:set_cwd(TargetDir), + + error = compile:file(Simple, [encrypt_debug_info,report]), + + NewKey = "better use another key here", + write_crypt_file(["[{debug_info,des3_cbc,simple,\"",NewKey,"\"}].\n"]), + {ok,simple} = compile:file(Simple, [encrypt_debug_info,report]), + verify_abstract("simple.beam", erl_abstract_code), + ok = file:delete(".erlang.crypt"), + beam_lib:clear_crypto_key_fun(), + {error,beam_lib,{key_missing_or_invalid,"simple.beam",abstract_code}} = beam_lib:chunks("simple.beam", [abstract_code]), - ?line ok = file:set_cwd(OldCwd), + ok = file:set_cwd(OldCwd), %% Test key compatibility by reading a BEAM file produced before %% the update to the new crypto functions. @@ -530,21 +612,21 @@ write_crypt_file(Contents0) -> encrypted_abstr_no_crypto(Simple, Target) -> io:format("simpe: ~p~n", [Simple]), - ?line TargetDir = filename:dirname(Target), - ?line Key = "ablurf123BX#$;3", - ?line error = compile:file(Simple, + TargetDir = filename:dirname(Target), + Key = "ablurf123BX#$;3", + error = compile:file(Simple, [debug_info,{debug_info_key,Key}, {outdir,TargetDir},report]), ok. -verify_abstract(Target) -> - {ok,{simple,[Chunk]}} = beam_lib:chunks(Target, [abstract_code]), - {abstract_code,{raw_abstract_v1,_}} = Chunk. +verify_abstract(Beam, Backend) -> + {ok,{simple,[Abst, Dbgi]}} = beam_lib:chunks(Beam, [abstract_code, debug_info]), + {abstract_code,{raw_abstract_v1,_}} = Abst, + {debug_info,{debug_info_v1,Backend,_}} = Dbgi. has_crypto() -> try crypto:start(), - <<_,_,_,_,_>> = crypto:rand_bytes(5), crypto:stop(), true catch @@ -559,8 +641,28 @@ install_crypto_key(Key) -> ok = beam_lib:crypto_key_fun(F). %% Miscellanous tests, mainly to get better coverage. +debug_info(erlang_v1, Module, ok, _Opts) -> + {ok, [Module]}; +debug_info(erlang_v1, _Module, error, _Opts) -> + {error, unknown_format}. + +custom_debug_info(Config) when is_list(Config) -> + {Simple,_} = get_files(Config, simple, "file_1"), + + {ok,simple,OkBin} = compile:file(Simple, [binary, {debug_info,{?MODULE,ok}}]), %Coverage + {ok,{simple,[{abstract_code,{raw_abstract_v1,[simple]}}]}} = + beam_lib:chunks(OkBin, [abstract_code]), + {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,ok}}]}} = + beam_lib:chunks(OkBin, [debug_info]), + + {ok,simple,ErrorBin} = compile:file(Simple, [binary, {debug_info,{?MODULE,error}}]), %Coverage + {ok,{simple,[{abstract_code,no_abstract_code}]}} = + beam_lib:chunks(ErrorBin, [abstract_code]), + {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,error}}]}} = + beam_lib:chunks(ErrorBin, [debug_info]). + cover(Config) when is_list(Config) -> - ?line io:format("~p\n", [compile:options()]), + io:format("~p\n", [compile:options()]), ok. do_listing(Source, TargetDir, Type) -> @@ -571,31 +673,31 @@ do_listing(Source, TargetDir, Type, Ext) -> [Source, TargetDir, Type, Ext]), case compile:file(Source, [Type, time, {outdir, TargetDir}]) of {ok, _} -> ok; - Other -> test_server:fail({unexpected_result, Other}) + Other -> ct:fail({unexpected_result, Other}) end, SourceBase = filename:rootname(filename:basename(Source)), Target = filename:join(TargetDir, SourceBase ++ Ext), true = exists(Target). -files(Config, Name) -> - ?line code:delete(simple), - ?line code:purge(simple), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, "simple"), - ?line TargetDir = filename:join(PrivDir, Name), - ?line ok = file:make_dir(TargetDir), - ?line Target = filename:join(TargetDir, "simple"++code:objfile_extension()), - {Simple, Target}. - +get_files(Config, Module, OutputName) -> + code:delete(Module), + code:purge(Module), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + Src = filename:join(DataDir, atom_to_list(Module)), + TargetDir = filename:join(PrivDir, OutputName), + ok = file:make_dir(TargetDir), + File = atom_to_list(Module) ++ code:objfile_extension(), + Target = filename:join(TargetDir, File), + {Src, Target}. run(Target, Func, Args) -> - ?line Module = list_to_atom(filename:rootname(filename:basename(Target))), - ?line {module, Module} = code:load_abs(filename:rootname(Target)), - ?line Result = (catch apply(Module, Func, Args)), - ?line true = code:delete(Module), - ?line false = code:purge(Module), + Module = list_to_atom(filename:rootname(filename:basename(Target))), + {module, Module} = code:load_abs(filename:rootname(Target)), + Result = (catch apply(Module, Func, Args)), + true = code:delete(Module), + false = code:purge(Module), Result. exists(Name) -> @@ -605,49 +707,27 @@ exists(Name) -> end. -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use1(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use2(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use2.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - strict_record(Config) when is_list(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line file:set_cwd(?config(data_dir, Config)), - ?line Opts = [{outdir,Priv},report_errors], + Priv = proplists:get_value(priv_dir, Config), + ok = file:set_cwd(proplists:get_value(data_dir, Config)), + Opts = [{outdir,Priv},report_errors], M = record_access, - ?line {ok,M} = c:c(M, [strict_record_tests|Opts]), - ?line Turtle = test_strict(), + {ok,M} = c:c(M, [strict_record_tests|Opts]), + Turtle = test_strict(), - ?line {ok,M} = c:c(M, [no_strict_record_tests|Opts]), - ?line Turtle = test_sloppy(), + {ok,M} = c:c(M, [no_strict_record_tests|Opts]), + Turtle = test_sloppy(), %% The option first given wins. - ?line {ok,M} = c:c(M, [no_strict_record_tests,strict_record_tests|Opts]), - ?line Turtle = test_sloppy(), - ?line {ok,M} = c:c(M, [strict_record_tests,no_strict_record_tests|Opts]), - ?line Turtle = test_strict(), + {ok,M} = c:c(M, [no_strict_record_tests,strict_record_tests|Opts]), + Turtle = test_sloppy(), + {ok,M} = c:c(M, [strict_record_tests,no_strict_record_tests|Opts]), + Turtle = test_strict(), %% Default (possibly influenced by ERL_COMPILER_OPTIONS). - ?line {ok,M} = c:c(M, [{outdir,Priv},report_errors]), - ?line try + {ok,M} = c:c(M, [{outdir,Priv},report_errors]), + try {1,2} = record_access:test(Turtle), {comment,"Default: no_strict_record_tests"} catch @@ -657,7 +737,7 @@ strict_record(Config) when is_list(Config) -> test_strict() -> Turtle = record_access:turtle(), - ?line try + try record_access:test(Turtle) catch error:{badrecord,tortoise} -> @@ -670,103 +750,105 @@ test_sloppy() -> {1,2} = record_access:test(Turtle), Turtle. -missing_testheap(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(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), - ?line ok = test(fun() -> - missing_testheap1:f({a,self()},{state,true,b}) - end, {a,b}), - ?line 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]), - test_server:fail() - end. +utf8_atoms(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Atom = binary_to_atom(<<"こんにちは"/utf8>>, utf8), + Forms = [{attribute,Anno,compile,[export_all]}, + {function,Anno,atom,0,[{clause,Anno,[],[],[{atom,Anno,Atom}]}]}], + + Utf8AtomForms = [{attribute,Anno,module,utf8_atom}|Forms], + {ok,utf8_atom,Utf8AtomBin} = + compile:forms(Utf8AtomForms, [binary]), + {ok,{utf8_atom,[{atoms,_}]}} = + beam_lib:chunks(Utf8AtomBin, [atoms]), + code:load_binary(utf8_atom, "compile_SUITE", Utf8AtomBin), + Atom = utf8_atom:atom(), + + NoUtf8AtomForms = [{attribute,Anno,module,no_utf8_atom}|Forms], + error = compile:forms(NoUtf8AtomForms, [binary, r19]). + +utf8_functions(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Atom = binary_to_atom(<<"こんにちは"/utf8>>, utf8), + Forms = [{attribute,Anno,compile,[export_all]}, + {function,Anno,Atom,0,[{clause,Anno,[],[],[{atom,Anno,world}]}]}], + + Utf8FunctionForms = [{attribute,Anno,module,utf8_function}|Forms], + {ok,utf8_function,Utf8FunctionBin} = + compile:forms(Utf8FunctionForms, [binary]), + {ok,{utf8_function,[{atoms,_}]}} = + beam_lib:chunks(Utf8FunctionBin, [atoms]), + code:load_binary(utf8_function, "compile_SUITE", Utf8FunctionBin), + world = utf8_function:Atom(), + + NoUtf8FunctionForms = [{attribute,Anno,module,no_utf8_function}|Forms], + error = compile:forms(NoUtf8FunctionForms, [binary, r19]). + +extra_chunks(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Forms = [{attribute,Anno,module,extra_chunks}], -init(ReplyTo, Fun, _Filler) -> - ReplyTo ! {result, Fun()}. + {ok,extra_chunks,ExtraChunksBinary} = + compile:forms(Forms, [binary, {extra_chunks, [{<<"ExCh">>, <<"Contents">>}]}]), + {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} = + beam_lib:chunks(ExtraChunksBinary, ["ExCh"]). env(Config) when is_list(Config) -> - ?line {Simple,Target} = files(Config, "file_1"), - ?line {ok,Cwd} = file:get_cwd(), - ?line ok = file:set_cwd(filename:dirname(Target)), + {Simple,Target} = get_files(Config, simple, env), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(filename:dirname(Target)), true = os:putenv("ERL_COMPILER_OPTIONS", "binary"), try env_1(Simple, Target) after true = os:putenv("ERL_COMPILER_OPTIONS", "ignore_me"), - file:set_cwd(Cwd), - file:delete(Target), - file:del_dir(filename:dirname(Target)) + file:set_cwd(Cwd), + file:delete(Target), + file:del_dir(filename:dirname(Target)) end, ok. env_1(Simple, Target) -> %% file - ?line {ok,simple,<<_/binary>>} = compile:file(Simple), - ?line {ok,simple} = compile:noenv_file(Simple, [debug_info]), - ?line true = exists(Target), - ?line {ok,{simple,[{abstract_code,Abstr0}]}} = + {ok,simple,<<_/binary>>} = compile:file(Simple), + {ok,simple} = compile:noenv_file(Simple, [debug_info]), + true = exists(Target), + {ok,{simple,[{abstract_code,Abstr0}]}} = beam_lib:chunks(Target, [abstract_code]), - ?line {raw_abstract_v1,Forms} = Abstr0, + {raw_abstract_v1,Forms} = Abstr0, %% forms - ?line true = os:putenv("ERL_COMPILER_OPTIONS", "strong_validation"), - ?line {ok,simple} = compile:forms(Forms), - ?line {ok,simple,<<"FOR1",_/binary>>} = compile:noenv_forms(Forms, []), + true = os:putenv("ERL_COMPILER_OPTIONS", "strong_validation"), + {ok,simple} = compile:forms(Forms), + {ok,simple,<<"FOR1",_/binary>>} = compile:noenv_forms(Forms, []), %% output_generated - ?line false = compile:output_generated([]), - ?line true = compile:noenv_output_generated([]), + false = compile:output_generated([]), + true = compile:noenv_output_generated([]), - ?line ok = file:delete(Target), + ok = file:delete(Target), ok. %% Test pretty-printing in Core Erlang format and then try to %% compile the generated Core Erlang files. -core(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - Outdir = filename:join(PrivDir, "core"), +core_pp(Config) when is_list(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), + TestBeams = get_unique_beam_files(), Abstr = [begin {ok,{Mod,[{abstract_code, {raw_abstract_v1,Abstr}}]}} = beam_lib:chunks(Beam, [abstract_code]), {Mod,Abstr} end || Beam <- TestBeams], - test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr). + test_lib:p_run(fun(F) -> do_core_pp(F, Outdir) end, Abstr). -do_core({M,A}, Outdir) -> +do_core_pp({M,A}, Outdir) -> try - do_core_1(M, A, Outdir) + do_core_pp_1(M, A, Outdir) catch throw:{error,Error} -> io:format("*** compilation failure '~p' for module ~s\n", @@ -778,11 +860,11 @@ do_core({M,A}, Outdir) -> error end. -do_core_1(M, A, Outdir) -> +do_core_pp_1(M, A, Outdir) -> {ok,M,Core0} = compile:forms(A, [to_core]), CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), CorePP = core_pp:format(Core0), - ok = file:write_file(CoreFile, CorePP), + ok = file:write_file(CoreFile, unicode:characters_to_binary(CorePP)), %% Parse the .core file and return the result as Core Erlang Terms. Core = case compile:file(CoreFile, [report_errors,from_core,no_copt,to_core,binary]) of @@ -792,7 +874,7 @@ do_core_1(M, A, Outdir) -> ok = file:delete(CoreFile), %% Compile as usual (including optimizations). - compile_forms(Core, [clint,from_core,binary]), + compile_forms(M, Core, [clint,from_core,binary]), %% Don't optimize to test that we are not dependent %% on the Core Erlang optmimization passes. @@ -801,29 +883,203 @@ do_core_1(M, A, Outdir) -> %% records; if sys_core_fold was run it would fix %% that; if sys_core_fold was not run v3_kernel would %% crash.) - compile_forms(Core, [clint,from_core,no_copt,binary]), + compile_forms(M, Core, [clint,from_core,no_copt,binary]), ok. -compile_forms(Forms, Opts) -> +compile_forms(Mod, Forms, Opts) -> case compile:forms(Forms, [report_errors|Opts]) of - {ok,[],_} -> ok; + {ok,Mod,_} -> ok; 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), + + TestBeams = get_unique_beam_files(), + 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. + {Core1,_} = cerl_trees:label(Core0), + do_core_roundtrip_2(Mod, Core1, Outdir), + + %% Run the inliner to force generation of variables + %% with numeric names. + {ok,Mod,Core2} = compile:forms(Abstr, [inline,to_core]), + do_core_roundtrip_2(Mod, Core2, 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, unicode:characters_to_binary(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. + +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) -> + case cerl:is_c_var(T1) andalso cerl:is_c_var(T2) of + true -> + diff_var(T1, T2); + false -> + case cerl:is_c_map(T1) andalso cerl:is_c_map(T2) of + true -> + diff_map(T1, T2); + false -> + diff_tuple(T1, T2) + end + end; +diff(E1, E2) -> + {'DIFF',E1,E2}. + +diff_var(V1, V2) -> + case {cerl:var_name(V1),cerl:var_name(V2)} of + {Same,Same} -> + V1; + {Name1,Name2} -> + %% The inliner uses integers as variable names. Such integers + %% are read back as atoms. + case is_integer(Name1) andalso + list_to_atom(integer_to_list(Name1)) =:= Name2 of + true -> + V1; + _ -> + cerl:update_c_var(V1, {'DIFF',Name1,Name2}) + end + end. + +%% Annotations for maps are not preserved exactly, but that is not +%% a real problem. Workaround by not comparing all annotations when +%% comparing maps. + +diff_map(M, M) -> + M; +diff_map(M1, M2) -> + case cerl:get_ann(M1) =:= cerl:get_ann(M2) of + false -> + diff_tuple(M1, M2); + true -> + case remove_compiler_gen(M1) =:= remove_compiler_gen(M2) of + true -> + M1; + false -> + diff_tuple(M1, M2) + end + end. + +diff_tuple(T1, T2) -> + L = diff(tuple_to_list(T1), tuple_to_list(T2)), + list_to_tuple(L). + +remove_compiler_gen(M) -> + Arg0 = cerl:map_arg(M), + Arg = cerl:set_ann(Arg0, []), + Es0 = cerl:map_es(M), + Es = [remove_compiler_gen_1(Pair) || Pair <- Es0], + cerl:update_c_map(M, Arg, Es). + +remove_compiler_gen_1(Pair) -> + Op0 = cerl:map_pair_op(Pair), + Op = cerl:set_ann(Op0, []), + K = cerl:map_pair_key(Pair), + V = cerl:map_pair_val(Pair), + cerl:update_c_map_pair(Pair, Op, K, V). + %% Compile to Beam assembly language (.S) and then try to %% run .S through the compiler again. asm(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(20)), - ?line PrivDir = ?config(priv_dir, Config), - ?line Outdir = filename:join(PrivDir, "asm"), - ?line ok = file:make_dir(Outdir), - - ?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"), - ?line TestBeams = filelib:wildcard(Wc), - ?line Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams), - ?line test_server:timetrap_cancel(Dog), + PrivDir = proplists:get_value(priv_dir, Config), + Outdir = filename:join(PrivDir, "asm"), + ok = file:make_dir(Outdir), + + TestBeams = get_unique_beam_files(), + Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams), Res. @@ -850,8 +1106,98 @@ do_asm(Beam, Outdir) -> error end. +%% Make sure that guards are fully optimized. Guards should +%% should use 'test' instructions, not 'bif' instructions. + +optimized_guards(_Config) -> + TestBeams = get_unique_beam_files(), + test_lib:p_run(fun(F) -> do_opt_guards(F) end, TestBeams). + +do_opt_guards(Beam) -> + {ok,{M,[{abstract_code,{raw_abstract_v1,A}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + try + {ok,M,Asm} = compile:forms(A, ['S']), + do_opt_guards_mod(Asm) + catch Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [M,Class,Error,erlang:get_stacktrace()]), + error + end. + +do_opt_guards_mod({Mod,_Exp,_Attr,Asm,_NumLabels}) -> + case do_opt_guards_fs(Mod, Asm) of + [] -> + ok; + [_|_]=Bifs -> + io:format("ERRORS FOR ~p:\n~p\n", [Mod,Bifs]), + error + end. + +do_opt_guards_fs(Mod, [{function,Name,Arity,_,Is}|Fs]) -> + Bifs0 = do_opt_guards_fun(Is), + + %% The compiler does not attempt to optimize 'xor'. + %% Therefore, ignore all functions that use 'xor' in + %% a guard. + Bifs = case lists:any(fun({bif,'xor',_,_,_}) -> true; + (_) -> false + end, Bifs0) of + true -> []; + false -> Bifs0 + end, + + %% Filter out the allowed exceptions. + FA = {Name,Arity}, + case {Bifs,is_exception(Mod, FA)} of + {[_|_],true} -> + io:format("~p:~p/~p IGNORED:\n~p\n", + [Mod,Name,Arity,Bifs]), + do_opt_guards_fs(Mod, Fs); + {[_|_],false} -> + [{FA,Bifs}|do_opt_guards_fs(Mod, Fs)]; + {[],false} -> + do_opt_guards_fs(Mod, Fs); + {[],true} -> + io:format("Redundant exception for ~p:~p/~p\n", + [Mod,Name,Arity]), + error(redundant) + end; +do_opt_guards_fs(_, []) -> []. + +do_opt_guards_fun([{bif,Name,{f,F},As,_}=I|Is]) when F =/= 0 -> + Arity = length(As), + case erl_internal:comp_op(Name, Arity) orelse + erl_internal:bool_op(Name, Arity) orelse + erl_internal:new_type_test(Name, Arity) of + true -> + [I|do_opt_guards_fun(Is)]; + false -> + do_opt_guards_fun(Is) + end; +do_opt_guards_fun([_|Is]) -> + do_opt_guards_fun(Is); +do_opt_guards_fun([]) -> []. + +is_exception(bs_match_SUITE, {matching_and_andalso_2,2}) -> true; +is_exception(bs_match_SUITE, {matching_and_andalso_3,2}) -> true; +is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; +is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; +is_exception(guard_SUITE, {basic_andalso_orelse,1}) -> true; +is_exception(guard_SUITE, {bad_guards,1}) -> true; +is_exception(guard_SUITE, {bad_guards_2,2}) -> true; +is_exception(guard_SUITE, {bad_guards_3,2}) -> true; +is_exception(guard_SUITE, {cqlc,4}) -> true; +is_exception(guard_SUITE, {csemi7,3}) -> true; +is_exception(guard_SUITE, {misc,1}) -> true; +is_exception(guard_SUITE, {nested_not_2b,4}) -> true; +is_exception(guard_SUITE, {tricky_1,2}) -> true; +is_exception(map_SUITE, {map_guard_update,2}) -> true; +is_exception(map_SUITE, {map_guard_update_variables,3}) -> true; +is_exception(_, _) -> false. + sys_pre_attributes(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), File = filename:join(DataDir, "attributes.erl"), Mod = attributes, CommonOpts = [binary,report,verbose, @@ -883,8 +1229,8 @@ sys_pre_attributes(Config) -> %% Test the dialyzer option to cover more code. dialyzer(Config) -> - Priv = ?config(priv_dir, Config), - file:set_cwd(?config(data_dir, Config)), + Priv = proplists:get_value(priv_dir, Config), + ok = file:set_cwd(proplists:get_value(data_dir, Config)), Opts = [{outdir,Priv},report_errors], M = dialyzer_test, {ok,M} = c:c(M, [dialyzer|Opts]), @@ -895,6 +1241,210 @@ dialyzer(Config) -> [{a,b,c}] = M:M(), ok. + +%% Test that warnings contain filenames and line numbers. +warnings(_Config) -> + Files = get_unique_files(".erl"), + test_lib:p_run(fun do_warnings/1, Files). + +do_warnings(F) -> + {ok,_,_,Ws} = compile:file(F, [binary,bin_opt_info,return]), + do_warnings_1(Ws, F). + +do_warnings_1([{"no_file",Ws}|_], F) -> + io:format("~s:\nMissing file for warnings: ~p\n", + [F,Ws]), + error; +do_warnings_1([{Name,Ws}|T], F) -> + case filename:extension(Name) of + ".erl" -> + do_warnings_2(Ws, T, F); + _ -> + io:format("~s:\nNo .erl extension\n", [F]), + error + end; +do_warnings_1([], _) -> ok. + +do_warnings_2([{Int,_,_}=W|T], Next, F) -> + if + is_integer(Int) -> + do_warnings_2(T, Next, F); + true -> + io:format("~s:\nMissing line number: ~p\n", + [F,W]), + error + end; +do_warnings_2([], Next, F) -> + do_warnings_1(Next, F). + + +%% Test that the compile:pre_load/0 function (used by 'erlc') +%% pre-loads the modules that are used by a typical compilation. + +pre_load_check(Config) -> + case test_server:is_cover() of + true -> + {skip,"Cover is running"}; + false -> + try + do_pre_load_check(Config) + after + dbg:stop_clear() + end + end. + +do_pre_load_check(Config) -> + DataDir = ?config(data_dir, Config), + Simple = filename:join(DataDir, "simple.erl"), + Big = filename:join(DataDir, "big.erl"), + {ok,_} = dbg:tracer(process, {fun pre_load_trace/2,[]}), + dbg:p(self(), call), + dbg:p(new, call), + {ok,_} = dbg:tpl({?MODULE,get_trace_data,0}, []), + {ok,_} = dbg:tp({code,ensure_modules_loaded,1}, []), + + %% Compile a simple module using the erl_compile interface + %% to find out the modules that are pre-loaded by + %% compile:pre_load/0. + Opts = #options{specific=[binary]}, + {ok,simple,_} = compile:compile(Simple, "", Opts), + [{code,ensure_modules_loaded,[PreLoaded0]}] = get_trace_data(), + PreLoaded1 = ordsets:from_list(PreLoaded0), + + %% Since 'compile' is the function doing the pre-loaded, + %% it is useless to include it in the list. + case ordsets:is_element(compile, PreLoaded1) of + true -> + io:put_chars("The 'compile' module should not be included " + "in the list of modules to be pre-loaded."), + ?t:fail(compile); + false -> + [] + end, + PreLoaded = ordsets:add_element(compile, PreLoaded1), + + %% Now unload all pre-loaded modules and all modules in + %% compiler application. Then compile a module to find + %% which modules that get loaded. + CompilerMods = compiler_modules(), + Unload = ordsets:union(ordsets:from_list(CompilerMods), PreLoaded), + _ = [begin + code:delete(M), + code:purge(M) + end || M <- Unload], + + {ok,_} = dbg:ctp({code,ensure_modules_loaded,1}), + {ok,_} = dbg:tp({code,ensure_loaded,1}, []), + {ok,big,_} = compile:file(Big, [binary]), + WasLoaded0 = get_trace_data(), + WasLoaded1 = [M || {code,ensure_loaded,[M]} <- WasLoaded0], + WasLoaded = ordsets:from_list(WasLoaded1), + + %% Check for modules that should have been pre-loaded. + case ordsets:subtract(WasLoaded, PreLoaded) of + [] -> + ok; + [_|_]=NotPreLoaded -> + io:format("The following modules were used " + "but not pre-loaded:\n~p\n", + [NotPreLoaded]), + ?t:fail({not_preload,NotPreLoaded}) + end, + + %% Check for modules that should not be pre-loaded. + case ordsets:subtract(PreLoaded, WasLoaded) of + [] -> + ok; + [_|_]=NotUsed -> + io:format("The following modules were pre-loaded" + " but not used:\n~p\n", + [NotUsed]), + ?t:fail({not_used,NotUsed}) + end, + + ok. + +get_trace_data() -> + %% Apparantely, doing a receive at the beginning of + %% a traced function can cause extra trace messages. + %% To avoid that, don't do the receive in this function. + do_get_trace_data(). + +do_get_trace_data() -> + receive + {trace_data,Data} -> Data + end. + +pre_load_trace({trace,Pid,call,{?MODULE,get_trace_data,[]}}, Acc) -> + Pid ! {trace_data,Acc}, + []; +pre_load_trace({trace,_,call,MFA}, Acc) -> + [MFA|Acc]. + +compiler_modules() -> + Wc = filename:join([code:lib_dir(compiler),"ebin","*.beam"]), + Ms = filelib:wildcard(Wc), + FN = filename, + [list_to_atom(FN:rootname(FN:basename(M), ".beam")) || M <- Ms]. + +%% Test that ERL_COMPILER_OPTIONS are correctly retrieved +%% by env_compiler_options/0 + +env_compiler_options(_Config) -> + Cases = [ + {"bin_opt_info", [bin_opt_info]}, + {"'S'", ['S']}, + {"{source, \"test.erl\"}", [{source, "test.erl"}]}, + {"[{d,macro_one,1},{d,macro_two}]", [{d, macro_one, 1}, {d, macro_two}]}, + {"[warn_export_all, warn_export_vars]", [warn_export_all, warn_export_vars]} + ], + F = fun({Env, Expected}) -> + true = os:putenv("ERL_COMPILER_OPTIONS", Env), + Expected = compile:env_compiler_options() + end, + lists:foreach(F, Cases). + +%% Test options for compatibility with previous major versions of OTP. + +bc_options(Config) -> + DataDir = proplists:get_value(data_dir, Config), + + 101 = highest_opcode(DataDir, small_float, [no_line_info]), + + 103 = highest_opcode(DataDir, big, + [no_record_opt,no_line_info,no_stack_trimming]), + + 125 = highest_opcode(DataDir, small_float, [no_line_info,no_float_opt]), + + 132 = highest_opcode(DataDir, small, + [no_record_opt,no_float_opt,no_line_info]), + + 136 = highest_opcode(DataDir, big, [no_record_opt,no_line_info]), + + 153 = highest_opcode(DataDir, big, [no_record_opt]), + 153 = highest_opcode(DataDir, big, [r16]), + 153 = highest_opcode(DataDir, big, [r17]), + 153 = highest_opcode(DataDir, big, [r18]), + 153 = highest_opcode(DataDir, big, [r19]), + 153 = highest_opcode(DataDir, small_float, [r16]), + 153 = highest_opcode(DataDir, small_float, []), + + 158 = highest_opcode(DataDir, small_maps, [r17]), + 158 = highest_opcode(DataDir, small_maps, [r18]), + 158 = highest_opcode(DataDir, small_maps, [r19]), + 158 = highest_opcode(DataDir, small_maps, []), + + 159 = highest_opcode(DataDir, big, []), + + ok. + +highest_opcode(DataDir, Mod, Opt) -> + Src = filename:join(DataDir, atom_to_list(Mod)++".erl"), + {ok,Mod,Beam} = compile:file(Src, [binary|Opt]), + {ok,{Mod,[{"Code",Code}]}} = beam_lib:chunks(Beam, ["Code"]), + <<16:32,0:32,HighestOpcode:32,_/binary>> = Code, + HighestOpcode. + %%% %%% Utilities. %%% @@ -906,3 +1456,21 @@ compile_and_verify(Name, Target, Opts) -> beam_lib:chunks(Target, [compile_info]), {options,BeamOpts} = lists:keyfind(options, 1, CInfo), Opts = BeamOpts. + +get_unique_beam_files() -> + get_unique_files(".beam"). + +get_unique_files(Ext) -> + Wc = filename:join(filename:dirname(code:which(?MODULE)), "*"++Ext), + [F || F <- filelib:wildcard(Wc), + not is_cloned(F, Ext), not is_lfe_module(F, Ext)]. + +is_cloned(File, Ext) -> + Mod = list_to_atom(filename:basename(File, Ext)), + test_lib:is_cloned_mod(Mod). + +is_lfe_module(File, Ext) -> + case filename:basename(File, Ext) of + "lfe_" ++ _ -> true; + _ -> false + end. |