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