1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%% Purpose : Compiles various modules with tough code
20
21-module(compilation_SUITE).
22-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
23	 init_per_group/2,end_per_group/2,
24	 beam_compiler_4/1,
25	 beam_compiler_6/1,
26	 beam_compiler_7/1,
27	 beam_compiler_8/1,
28	 beam_compiler_9/1,
29	 beam_compiler_10/1,
30	 beam_compiler_11/1,
31	 compiler_1/1,
32	 const_list_256/1,
33	 convopts/1,
34	 live_var/1,
35	 on_load/1,
36	 on_load_inline/1,
37	 opt_crash/1,
38	 otp_2330/1,
39	 otp_2380/1,
40	 otp_4790/1,
41	 otp_5151/1,
42	 otp_5235/1,
43	 otp_5404/1,
44	 otp_5436/1,
45	 otp_5481/1,
46	 otp_5553/1,
47	 otp_5632/1,
48	 otp_5714/1,
49	 otp_5872/1,
50	 otp_6121/1,
51	 otp_7202/1,
52	 otp_8949_a/1,
53	 redundant_case/1,
54	 self_compile/1,
55	 self_compile_old_inliner/1,
56	 split_cases/1,
57	 string_table/1,
58	 vsn_1/1,
59	 vsn_2/1,
60         vsn_3/1,
61         infinite_loop/0,infinite_loop/1]).
62
63-include_lib("common_test/include/ct.hrl").
64
65suite() ->
66    [{ct_hooks,[ts_install_cth]},
67     {timetrap,{minutes,10}}].
68
69all() ->
70    [self_compile_old_inliner,self_compile,
71     {group,p}].
72
73groups() ->
74    [{vsn,[parallel],[vsn_1,vsn_2,vsn_3]},
75     {p,test_lib:parallel(),
76      [compiler_1,
77       beam_compiler_4,beam_compiler_6,beam_compiler_7,
78       beam_compiler_8,beam_compiler_9,beam_compiler_10,
79       beam_compiler_11,
80       otp_2330,
81       {group,vsn},otp_2380,otp_4790,
82       const_list_256,live_var,convopts,
83       redundant_case,
84       otp_5151,otp_5235,
85       opt_crash,otp_5404,otp_5436,otp_5481,
86       otp_5553,otp_5632,otp_5714,otp_5872,otp_6121,
87       otp_7202,on_load,on_load_inline,
88       string_table,otp_8949_a,split_cases,
89       infinite_loop]}].
90
91init_per_suite(Config) ->
92    test_lib:recompile(?MODULE),
93    Config.
94
95end_per_suite(_Config) ->
96    ok.
97
98init_per_group(_GroupName, Config) ->
99    Config.
100
101end_per_group(_GroupName, Config) ->
102    Config.
103
104-define(comp(N),
105	N(Config) when is_list(Config) -> try_it(N, Config)).
106
107?comp(compiler_1).
108
109?comp(beam_compiler_4).
110?comp(beam_compiler_6).
111?comp(beam_compiler_8).
112?comp(beam_compiler_9).
113?comp(beam_compiler_10).
114?comp(beam_compiler_11).
115
116?comp(otp_2330).
117?comp(otp_2380).
118?comp(otp_4790).
119?comp(otp_5235).
120
121?comp(const_list_256).
122
123?comp(otp_5151).
124
125?comp(live_var).
126?comp(opt_crash).
127
128?comp(otp_5404).
129?comp(otp_5436).
130?comp(otp_5481).
131?comp(otp_5553).
132?comp(otp_5632).
133?comp(otp_5714).
134?comp(otp_5872).
135?comp(otp_6121).
136?comp(convopts).
137?comp(otp_7202).
138?comp(on_load).
139?comp(on_load_inline).
140
141infinite_loop() -> [{timetrap,{minutes,1}}].
142?comp(infinite_loop).
143
144%% Code snippet submitted from Ulf Wiger which fails in R3 Beam.
145beam_compiler_7(Config) when is_list(Config) ->
146    done = empty(2, false).
147
148empty(N, Toggle) when N > 0 ->
149    %% R3 Beam copies the second argument to the first before call.
150    empty(N-1, not(Toggle));
151empty(_, _) ->
152    done.
153
154redundant_case(Config) when is_list(Config) ->
155    d = redundant_case_1(1),
156    d = redundant_case_1(2),
157    d = redundant_case_1(3),
158    d = redundant_case_1(4),
159    d = redundant_case_1(5),
160    d = redundant_case_1({glurf,glarf}),
161    ok.
162
163%% This function always returns 'd'. Check that the compiler otptimizes
164%% it properly.
165redundant_case_1(1) -> d;
166redundant_case_1(2) -> d;
167redundant_case_1(3) -> d;
168redundant_case_1(4) -> d;
169redundant_case_1(_) -> d.
170
171try_it(Module, Conf) ->
172    Timetrap = {minutes,10},
173    OtherOpts = [],			%Can be changed to [time] if needed
174    Src = filename:join(proplists:get_value(data_dir, Conf),
175			atom_to_list(Module)),
176    Out = proplists:get_value(priv_dir,Conf),
177    io:format("Compiling: ~s\n", [Src]),
178    CompRc0 = compile:file(Src, [clint0,clint,ssalint,{outdir,Out},report,
179				 bin_opt_info,recv_opt_info|OtherOpts]),
180    io:format("Result: ~p\n",[CompRc0]),
181    {ok,Mod} = CompRc0,
182
183    load_and_call(Out, Module),
184
185    ct:timetrap(Timetrap),
186    io:format("Compiling (without optimization): ~s\n", [Src]),
187    CompRc1 = compile:file(Src,
188			   [no_copt,no_postopt,
189			    {outdir,Out},report|OtherOpts]),
190
191    io:format("Result: ~p\n",[CompRc1]),
192    {ok,Mod} = CompRc1,
193    load_and_call(Out, Module),
194
195    ct:timetrap(Timetrap),
196    io:format("Compiling (with old inliner): ~s\n", [Src]),
197    CompRc2 = compile:file(Src, [clint,ssalint,
198				 {outdir,Out},report,bin_opt_info,
199				 recv_opt_info,{inline,1000}|OtherOpts]),
200    io:format("Result: ~p\n",[CompRc2]),
201    {ok,Mod} = CompRc2,
202    load_and_call(Out, Module),
203
204    ct:timetrap(Timetrap),
205    io:format("Compiling (from assembly): ~s\n", [Src]),
206    {ok,_} = compile:file(Src, [to_asm,{outdir,Out},report|OtherOpts]),
207    Asm = filename:join(Out, lists:concat([Module, ".S"])),
208    CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]),
209    io:format("Result: ~p\n",[CompRc3]),
210    {ok,_} = CompRc3,
211    load_and_call(Out, Module),
212
213    ok.
214
215load_and_call(Out, Module) ->
216    io:format("Loading...\n",[]),
217    {module,Module} = code:load_abs(filename:join(Out, Module)),
218
219    io:format("Calling...\n",[]),
220    %% Call M:M, and expect ok back, that's our interface
221    CallRc = Module:Module(),
222    io:format("Got value: ~p\n",[CallRc]),
223
224    ok = CallRc,
225
226    %% Smoke-test of beam disassembler.
227    test_lib:smoke_disasm(Module),
228
229    _ = code:delete(Module),
230    _ = code:purge(Module),
231
232    %% Restore state of trap_exit just in case. (Since the compiler
233    %% uses a temporary process, we will get {'EXIT',Pid,normal} messages
234    %% if trap_exit is true.)
235
236    process_flag(trap_exit, false),
237    ok.
238
239
240%% Test generation of 'vsn' attribute.
241vsn_1(Conf) when is_list(Conf) ->
242    M = vsn_1,
243
244    compile_load(M, proplists:get_value(data_dir, Conf), Conf),
245    Vsn1 = get_vsn(M),
246    timer:sleep(1000),
247
248    compile_load(M, proplists:get_value(data_dir, Conf), Conf),
249    Vsn2 = get_vsn(M),
250
251    compile_load(M, filename:join(proplists:get_value(data_dir, Conf),
252				  "other"),
253		 Conf),
254    Vsn3 = get_vsn(M),
255    if
256	Vsn1 == Vsn2, Vsn2 == Vsn3 ->
257	    ok;
258	true ->
259	    ct:fail({vsn, Vsn1, Vsn2, Vsn3})
260    end,
261    ok.
262
263%% Test overriding of generation of 'vsn' attribute.
264vsn_2(Conf) when is_list(Conf) ->
265    M = vsn_2,
266
267    compile_load(M, proplists:get_value(data_dir, Conf), Conf),
268    Vsn = get_vsn(M),
269    case Vsn of
270	[34] ->
271	    ok;
272	_ ->
273	    ct:fail({vsn, Vsn})
274    end,
275    ok.
276
277%% Test that different code yields different generated 'vsn'.
278vsn_3(Conf) when is_list(Conf) ->
279    M = vsn_3,
280
281    compile_load(M, proplists:get_value(data_dir, Conf), Conf),
282    Vsn1 = get_vsn(M),
283
284    compile_load(M, filename:join(proplists:get_value(data_dir, Conf),
285				  "other"),
286		 Conf),
287    Vsn2 = get_vsn(M),
288    if
289	Vsn1 /= Vsn2 ->
290	    ok;
291	true ->
292	    ct:fail({vsn, Vsn1, Vsn2})
293    end,
294    ok.
295
296get_vsn(M) ->
297    {vsn,V} = lists:keyfind(vsn, 1, M:module_info(attributes)),
298    V.
299
300compile_load(Module, Dir, Conf) ->
301    Src = filename:join(Dir, atom_to_list(Module)),
302    Out = proplists:get_value(priv_dir,Conf),
303    CompRc = compile:file(Src, [{outdir,Out}]),
304    {ok, Module} = CompRc,
305    code:purge(Module),
306    {module, Module} =
307	code:load_abs(filename:join(Out, atom_to_list(Module))),
308    ok.
309
310self_compile(Config) when is_list(Config) ->
311    self_compile_1(Config, "new", [inline]).
312
313self_compile_old_inliner(Config) when is_list(Config) ->
314    %% The old inliner is useful for testing that sys_core_fold does not
315    %% introduce name capture problems.
316    self_compile_1(Config, "old", [verbose,{inline,500}]).
317
318self_compile_1(Config, Prefix, Opts) ->
319    ct:timetrap({minutes,40}),
320
321    Priv = proplists:get_value(priv_dir,Config),
322    Version = compiler_version(),
323
324    %% Compile the compiler. (In this node to get better coverage.)
325    CompA = make_compiler_dir(Priv, Prefix++"compiler_a"),
326    VsnA = Version ++ ".0",
327    compile_compiler(compiler_src(), CompA, VsnA, Opts),
328
329    %% Compile the compiler again using the newly compiled compiler.
330    %% (In another node because reloading the compiler would disturb cover.)
331    CompilerB = Prefix++"compiler_b",
332    CompB = make_compiler_dir(Priv, CompilerB),
333    VsnB = VsnA ++ ".0",
334    self_compile_node(CompA, CompB, VsnB, Opts),
335
336    %% Compare compiler directories. The compiler directories should
337    %% be equal (except for beam_asm that contains the compiler version).
338    compare_compilers(CompA, CompB),
339
340    ok.
341
342self_compile_node(CompilerDir, OutDir, Version, Opts) ->
343    ct:timetrap({minutes,15}),
344    Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++
345	" -pa " ++ CompilerDir,
346    Files = compiler_src(),
347
348    %% We don't want the cover server started on the other node,
349    %% because it will load the same cover-compiled code as on this
350    %% node. Use a shielded node to prevent the cover server from
351    %% being started.
352    test_server:run_on_shielded_node(
353      fun() ->
354	      compile_compiler(Files, OutDir, Version, Opts)
355      end, Pa),
356
357    ok.
358
359compile_compiler(Files, OutDir, Version, InlineOpts) ->
360    io:format("~ts", [code:which(compile)]),
361    io:format("Compiling ~s into ~ts", [Version,OutDir]),
362    Opts = [report,
363	    clint0,clint,ssalint,
364	    bin_opt_info,
365            recv_opt_info,
366	    {outdir,OutDir},
367	    {d,'COMPILER_VSN',"\""++Version++"\""},
368	    nowarn_shadow_vars,
369	    {i,filename:join(code:lib_dir(stdlib), "include")}|InlineOpts],
370    test_lib:p_run(fun(File) ->
371			   case compile:file(File, Opts) of
372			       {ok,_} -> ok;
373			       _ -> error
374			   end
375		   end, Files).
376
377compiler_src() ->
378    filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])).
379
380make_compiler_dir(Priv, Dir0) ->
381    Dir = filename:join(Priv, Dir0),
382    ok = file:make_dir(Dir),
383    Dir.
384
385compiler_version() ->
386    {version,Version} = lists:keyfind(version, 1,
387				      compile:module_info(compile)),
388    Version.
389
390compare_compilers(ADir, BDir) ->
391    {[],[],D} = beam_lib:cmp_dirs(ADir, BDir),
392
393    %% beam_asm.beam contains compiler version and therefore it *must*
394    %% compare unequal.
395    ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D],
396    ok.
397
398%% Check the generation of the string table.
399
400string_table(Config) when is_list(Config) ->
401    DataDir = proplists:get_value(data_dir, Config),
402    File = filename:join(DataDir, "string_table.erl"),
403    {ok,string_table,Beam,[]} = compile:file(File, [return, binary]),
404    {ok,{string_table,[StringTableChunk]}} = beam_lib:chunks(Beam, ["StrT"]),
405    {"StrT", <<"stringtable">>} = StringTableChunk,
406    ok.
407
408otp_8949_a(Config) when is_list(Config) ->
409    value = do_otp_8949_a(),
410    ok.
411
412-record(cs, {exs,keys = [],flags = 1}).
413-record(exs, {children = []}).
414
415do_otp_8949_a() ->
416    case id([#cs{}]) of
417        [#cs{}=Cs] ->
418            SomeVar = id(value),
419	    if
420		Cs#cs.flags band 1 =/= 0 ->
421		    id(SomeVar);
422		(((Cs#cs.exs)#exs.children /= [])
423                 and
424		   (Cs#cs.flags band (1 bsl 0 bor (1 bsl 22)) == 0));
425		Cs#cs.flags band (1 bsl 22) =/= 0 ->
426		    ok
427	    end
428    end.
429
430split_cases(_) ->
431    dummy1 = do_split_cases(x),
432    {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)),
433    ok.
434
435do_split_cases(A) ->
436    case A of
437        x ->
438	    Z = dummy1;
439        _ ->
440	    Z = dummy2,
441	    a=b
442    end,
443    Z.
444
445
446id(I) -> I.
447