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