%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1997-2016. 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. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% %CopyrightEnd% %%% Purpose : Compiles various modules with tough code -module(compilation_SUITE). -include_lib("common_test/include/ct.hrl"). -compile(export_all). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,10}}]. all() -> test_lib:recompile(?MODULE), [self_compile_old_inliner,self_compile, {group,p}]. groups() -> [{vsn,[parallel],[vsn_1,vsn_2,vsn_3]}, {p,test_lib:parallel(), [compiler_1, compiler_3,compiler_5,beam_compiler_1, beam_compiler_2,beam_compiler_3,beam_compiler_4, beam_compiler_5,beam_compiler_6,beam_compiler_7, beam_compiler_8,beam_compiler_9,beam_compiler_10, beam_compiler_11,beam_compiler_12, nested_tuples_in_case_expr,otp_2330,guards, {group,vsn},otp_2380,otp_2141,otp_2173,otp_4790, const_list_256,bin_syntax_1,bin_syntax_2, bin_syntax_3,bin_syntax_4,bin_syntax_5,bin_syntax_6, live_var,convopts, catch_in_catch,redundant_case,long_string,otp_5076, complex_guard,otp_5092,otp_5151,otp_5235,otp_5244, trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, string_table,otp_8949_a,otp_8949_b,split_cases, beam_utils_liveopt]}]. init_per_suite(Config) -> Config. end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. -define(comp(N), N(Config) when is_list(Config) -> try_it(N, Config)). -define(comp_fail(N), N(Config) when is_list(Config) -> failure(N, Config)). ?comp(compiler_1). ?comp(compiler_3). ?comp(compiler_4). ?comp(compiler_5). ?comp(beam_compiler_1). ?comp(beam_compiler_2). ?comp(beam_compiler_3). ?comp(beam_compiler_4). ?comp(beam_compiler_5). ?comp(beam_compiler_6). ?comp(beam_compiler_8). ?comp(beam_compiler_9). ?comp(beam_compiler_10). ?comp(beam_compiler_11). ?comp(beam_compiler_12). ?comp(beam_compiler_13). ?comp(nested_tuples_in_case_expr). ?comp(otp_2330). ?comp(otp_2380). ?comp(otp_2141). ?comp(otp_2173). ?comp(otp_4790). ?comp(otp_5235). ?comp(otp_5244). ?comp(guards). ?comp(pattern_expr). ?comp(const_list_256). ?comp(bin_syntax_1). ?comp(bin_syntax_2). ?comp(bin_syntax_3). ?comp(bin_syntax_4). ?comp(bin_syntax_6). ?comp(otp_5076). ?comp(complex_guard). ?comp(otp_5092). ?comp(otp_5151). %%% By Per Gustafsson bin_syntax_5(Config) when is_list(Config) -> {<<45>>,<<>>} = split({int, 1}, <<1:16,45>>). split({int, N}, <>) -> {B,T}. %% This program works with the old version of the compiler %% but, the core erlang that it produces have the same variable appearing %% looks like this: %% %% split({int, N}, <<_core1:16, B:N/binary, T/binary>>) when _core1==N %% %% with my change it will look like this: %% %% split({int, N}, <<_core1:16, B:_core1/binary, T/binary>>) when _core1==N %% %% This means that everything worked fine as long as the pattern %% matching order was left-to-right but on core erlang any order should be possible ?comp(live_var). ?comp(trycatch_4). ?comp(catch_in_catch). ?comp(opt_crash). ?comp(otp_5404). ?comp(otp_5436). ?comp(otp_5481). ?comp(otp_5553). ?comp(otp_5632). ?comp(otp_5714). ?comp(otp_5872). ?comp(otp_6121). ?comp(otp_6121a). ?comp(otp_6121b). ?comp(convopts). ?comp(otp_7202). ?comp(on_load). ?comp(on_load_inline). %% Code snippet submitted from Ulf Wiger which fails in R3 Beam. beam_compiler_7(Config) when is_list(Config) -> done = empty(2, false). empty(N, Toggle) when N > 0 -> %% R3 Beam copies the second argument to the first before call. empty(N-1, not(Toggle)); empty(_, _) -> done. redundant_case(Config) when is_list(Config) -> d = redundant_case_1(1), d = redundant_case_1(2), d = redundant_case_1(3), d = redundant_case_1(4), d = redundant_case_1(5), d = redundant_case_1({glurf,glarf}), ok. %% This function always returns 'd'. Check that the compiler otptimizes %% it properly. redundant_case_1(1) -> d; redundant_case_1(2) -> d; redundant_case_1(3) -> d; redundant_case_1(4) -> d; redundant_case_1(_) -> d. failure(Module, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), atom_to_list(Module)), Out = proplists:get_value(priv_dir, Conf), io:format("Compiling: ~ts\n", [Src]), CompRc = compile:file(Src, [{outdir,Out},return,time]), io:format("Result: ~p\n",[CompRc]), case CompRc of error -> ok; {error,Errors,_} -> check_errors(Errors); _ -> ct:fail({no_error, CompRc}) end, ok. check_errors([{_,Eds}|T]) -> check_error(Eds), check_errors(T); check_errors([]) -> ok. check_error([{_,Mod,Error}|T]) -> check_error_1(Mod:format_error(Error)), check_error(T); check_error([{Mod,Error}|T]) -> check_error_1(Mod:format_error(Error)), check_error(T); check_error([]) -> ok. check_error_1(Str0) -> Str = lists:flatten(Str0), io:format("~s\n", [Str]), case Str of "internal"++_=Str -> ct:fail(internal_compiler_error); _ -> ok end. -define(TC(Body), tc(fun() -> Body end, ?LINE)). try_it(Module, Conf) -> %% Change 'false' to 'true' to start a new node for every module. try_it(false, Module, Conf). try_it(StartNode, Module, Conf) -> try_it(StartNode, Module, {minutes,10}, Conf). try_it(StartNode, Module, Timetrap, Conf) -> OtherOpts = [], %Can be changed to [time] if needed Src = filename:join(proplists:get_value(data_dir, Conf), atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), io:format("Compiling: ~s\n", [Src]), CompRc0 = compile:file(Src, [clint0,clint,{outdir,Out},report, bin_opt_info|OtherOpts]), io:format("Result: ~p\n",[CompRc0]), {ok,_Mod} = CompRc0, Node = case StartNode of false -> node(); true -> Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), {ok,Node0} = start_node(compiler, Pa), Node0 end, ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (without optimization): ~s\n", [Src]), CompRc1 = compile:file(Src, [no_copt,no_postopt, {outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc1]), {ok,_Mod} = CompRc1, ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), ct:timetrap(Timetrap), io:format("Compiling (with old inliner): ~s\n", [Src]), CompRc2 = compile:file(Src, [clint, {outdir,Out},report,bin_opt_info, {inline,1000}|OtherOpts]), io:format("Result: ~p\n",[CompRc2]), {ok,_Mod} = CompRc2, ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), ct:timetrap(Timetrap), io:format("Compiling (from assembly): ~s\n", [Src]), {ok,_} = compile:file(Src, [to_asm,{outdir,Out},report|OtherOpts]), Asm = filename:join(Out, lists:concat([Module, ".S"])), CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc3]), {ok,_} = CompRc3, ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), case StartNode of false -> ok; true -> test_server:stop_node(Node) end, ok. load_and_call(Out, Module) -> io:format("Loading...\n",[]), {module,Module} = code:load_abs(filename:join(Out, Module)), io:format("Calling...\n",[]), %% Call M:M, and expect ok back, that's our interface CallRc = Module:Module(), io:format("Got value: ~p\n",[CallRc]), ok = CallRc, %% Smoke-test of beam disassembler. test_lib:smoke_disasm(Module), _ = code:delete(Module), _ = code:purge(Module), %% Restore state of trap_exit just in case. (Since the compiler %% uses a temporary process, we will get {'EXIT',Pid,normal} messages %% if trap_exit is true.) process_flag(trap_exit, false), ok. tc(F, Line) -> {Diff,Value} = timer:tc(erlang, apply, [F,[]]), io:format("~p: ~p\n", [Line,Diff]), Value. start_node(Name, Args) -> case test_server:start_node(Name, slave, [{args, Args}]) of {ok, Node} -> {ok, Node}; Error -> ct:fail(Error) end. from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_, []) -> []. %% Test generation of 'vsn' attribute. vsn_1(Conf) when is_list(Conf) -> M = vsn_1, compile_load(M, proplists:get_value(data_dir, Conf), Conf), Vsn1 = get_vsn(M), timer:sleep(1000), compile_load(M, proplists:get_value(data_dir, Conf), Conf), Vsn2 = get_vsn(M), compile_load(M, filename:join(proplists:get_value(data_dir, Conf), "other"), Conf), Vsn3 = get_vsn(M), if Vsn1 == Vsn2, Vsn2 == Vsn3 -> ok; true -> ct:fail({vsn, Vsn1, Vsn2, Vsn3}) end, ok. %% Test overriding of generation of 'vsn' attribute. vsn_2(Conf) when is_list(Conf) -> M = vsn_2, compile_load(M, proplists:get_value(data_dir, Conf), Conf), Vsn = get_vsn(M), case Vsn of [34] -> ok; _ -> ct:fail({vsn, Vsn}) end, ok. %% Test that different code yields different generated 'vsn'. vsn_3(Conf) when is_list(Conf) -> M = vsn_3, compile_load(M, proplists:get_value(data_dir, Conf), Conf), Vsn1 = get_vsn(M), compile_load(M, filename:join(proplists:get_value(data_dir, Conf), "other"), Conf), Vsn2 = get_vsn(M), if Vsn1 /= Vsn2 -> ok; true -> ct:fail({vsn, Vsn1, Vsn2}) end, ok. get_vsn(M) -> {vsn,V} = lists:keyfind(vsn, 1, M:module_info(attributes)), V. long_string(Config) when is_list(Config) -> %% The test must complete in one minute - it should be plenty of time. try_it(false, long_string, {minutes,1}, Config), ok. compile_load(Module, Dir, Conf) -> Src = filename:join(Dir, atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), CompRc = compile:file(Src, [{outdir,Out}]), {ok, Module} = CompRc, code:purge(Module), {module, Module} = code:load_abs(filename:join(Out, atom_to_list(Module))), ok. self_compile(Config) when is_list(Config) -> self_compile_1(Config, "new", [inline]). self_compile_old_inliner(Config) when is_list(Config) -> %% The old inliner is useful for testing that sys_core_fold does not %% introduce name capture problems. self_compile_1(Config, "old", [verbose,{inline,500}]). self_compile_1(Config, Prefix, Opts) -> ct:timetrap({minutes,40}), Priv = proplists:get_value(priv_dir,Config), Version = compiler_version(), %% Compile the compiler. (In this node to get better coverage.) CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), VsnA = Version ++ ".0", compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) CompilerB = Prefix++"compiler_b", CompB = make_compiler_dir(Priv, CompilerB), VsnB = VsnA ++ ".0", self_compile_node(CompA, CompB, VsnB, Opts), %% Compare compiler directories. The compiler directories should %% be equal (except for beam_asm that contains the compiler version). compare_compilers(CompA, CompB), ok. self_compile_node(CompilerDir, OutDir, Version, Opts) -> ct:timetrap({minutes,15}), Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " -pa " ++ CompilerDir, Files = compiler_src(), %% We don't want the cover server started on the other node, %% because it will load the same cover-compiled code as on this %% node. Use a shielded node to prevent the cover server from %% being started. test_server:run_on_shielded_node( fun() -> compile_compiler(Files, OutDir, Version, Opts) end, Pa), ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> io:format("~ts", [code:which(compile)]), io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, clint0,clint, bin_opt_info, {outdir,OutDir}, {d,'COMPILER_VSN',"\""++Version++"\""}, nowarn_shadow_vars, {i,filename:join(code:lib_dir(stdlib), "include")}|InlineOpts], test_lib:p_run(fun(File) -> case compile:file(File, Opts) of {ok,_} -> ok; _ -> error end end, Files). compiler_src() -> filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])). compiler_modules(Dir) -> Files = filelib:wildcard(filename:join(Dir, "*.beam")), [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. make_compiler_dir(Priv, Dir0) -> Dir = filename:join(Priv, Dir0), ok = file:make_dir(Dir), Dir. compiler_version() -> {version,Version} = lists:keyfind(version, 1, compile:module_info(compile)), Version. compare_compilers(ADir, BDir) -> {[],[],D} = beam_lib:cmp_dirs(ADir, BDir), %% beam_asm.beam contains compiler version and therefore it *must* %% compare unequal. ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], ok. %%% %%% The only test of the following code is that it compiles. %%% %% Slightly simplifed from megaco_binary_term_id_gen. %% beam_block failed to note that the {gc_bif,'-'...} instruction could %% fail, and that therefore {y,0} need to be initialized. %% {allocate,8,6}. %% %% {init,{y,0}} needed here. %% {get_list,{x,1},{x,6},{x,7}}. %% {'catch',{y,7},{f,3}}. %% {move,{x,4},{y,1}}. %% {move,{x,3},{y,2}}. %% {move,{x,2},{y,3}}. %% {move,{x,5},{y,4}}. %% {move,{x,7},{y,5}}. %% {move,{x,6},{y,6}}. %% {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}. %% {move,{x,0},{y,0}}. encode_wildcards3([],[],_,_) -> []; encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) -> case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel, length(Levels))) of {'EXIT',{Reason,Info}} -> exit({Reason,{LevelNo,Info}}); no_wildcard -> encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel); {level,Wl} -> [Wl| encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)]; {recursive,Wr} -> [Wr] end. %% Slightly simplified code from hipe_rtl_ssapre. %% beam_block used to do the following incorrect optimization: %% %% {gc_bif,length,{f,0},1,[{x,0}],{x,3}}. %% ^^^^^ Was {x,0} - changing to {x,3} is not safe. %% {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}. %% ^^^ Only one register live %% . . . %% {call_last,4,{f,2},4}. %% beam_validator noted that {x,3} wasn't live. find_operands(Cfg,XsiGraph,[],_Count) -> {Cfg,XsiGraph}; find_operands(Cfg,XsiGraph,ActiveList,Count) -> {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph, ActiveList,[]), NewActiveList=lists:reverse(TempActiveList), [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))], find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). %% The following code %% %% {get_list,{x,2},{x,0},{x,1}}. %% {gc_bif,length,{f,0},1,[{x,0}],{x,0}}. %% {move,{x,0},{x,1}}. %% %% was incorrectly optimized to %% %% {get_list,{x,2},{x,0},{y,0}}. %% {gc_bif,length,{f,0},3,[{x,0}],{x,1}}. %% %% because beam_block:is_transparent({x,1}, %% {gc_bif,length,{f,0},3,[{x,0}],{x,1}} %% incorrectly returned true. -record(contextId,{cid,device_type,contextRef}). -record(dpRef,{cid,tlli,ms_device_context_id}). -record(qosProfileBssgp,{peak_bit_rate_msb, peak_bit_rate_lsb, t_a_precedence}). -record(llUnitdataReq,{sapi, l3_pdu_length, pdu_life}). -record(ptmsi,{value}). otp_7345(Config) when is_list(Config) -> #llUnitdataReq{l3_pdu_length=3,pdu_life=4} = otp_7345(#contextId{}, 0, [[1,2,3],4,5]). otp_7345(ObjRef, _RdEnv, Args) -> Cid = ObjRef#contextId.cid, _ = #dpRef{cid = Cid, ms_device_context_id = cid_id, tlli = #ptmsi{value = 0}}, _ = #qosProfileBssgp{peak_bit_rate_msb = 0, peak_bit_rate_lsb = 80, t_a_precedence = 49}, [Cpdu|_] = Args, LlUnitdataReq = #llUnitdataReq{sapi = 7, l3_pdu_length = length(Cpdu), pdu_life = id(42) div 10}, id(LlUnitdataReq). %% Check the generation of the string table. string_table(Config) when is_list(Config) -> DataDir = proplists:get_value(data_dir, Config), File = filename:join(DataDir, "string_table.erl"), {ok,string_table,Beam,[]} = compile:file(File, [return, binary]), {ok,{string_table,[StringTableChunk]}} = beam_lib:chunks(Beam, ["StrT"]), {"StrT", <<"stringtable">>} = StringTableChunk, ok. otp_8949_a(Config) when is_list(Config) -> value = do_otp_8949_a(), ok. -record(cs, {exs,keys = [],flags = 1}). -record(exs, {children = []}). do_otp_8949_a() -> case id([#cs{}]) of [#cs{}=Cs] -> SomeVar = id(value), if Cs#cs.flags band 1 =/= 0 -> id(SomeVar); (((Cs#cs.exs)#exs.children /= []) and (Cs#cs.flags band (1 bsl 0 bor (1 bsl 22)) == 0)); Cs#cs.flags band (1 bsl 22) =/= 0 -> ok end end. otp_8949_b(Config) when is_list(Config) -> self() ! something, value = otp_8949_b([], false), {'EXIT',_} = (catch otp_8949_b([], true)), ok. %% Would cause an endless loop in beam_utils. otp_8949_b(A, B) -> Var = id(value), if A == [], B == false -> ok end, receive something -> id(Var) end. split_cases(_) -> dummy1 = do_split_cases(x), {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)), ok. do_split_cases(A) -> case A of x -> Z = dummy1; _ -> Z = dummy2, a=b end, Z. -record(alarmInfo, {type,cause,origin}). beam_utils_liveopt(Config) -> F = beam_utils_liveopt_fun(42, pebkac, user), void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), ok. beam_utils_liveopt_fun(Peer, Cause, Origin) -> fun(PeerNo, AlarmInfo) when PeerNo == Peer andalso AlarmInfo == #alarmInfo{type=sctp, cause=Cause, origin=Origin} -> void end. id(I) -> I.