1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-2020. 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%%
20-module(core_fold_SUITE).
21
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	 t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
25	 eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1,
26	 unused_multiple_values_error/1,unused_multiple_values/1,
27	 multiple_aliases/1,redundant_boolean_clauses/1,
28	 mixed_matching_clauses/1,unnecessary_building/1,
29	 no_no_file/1,configuration/1,supplies/1,
30         redundant_stack_frame/1,export_from_case/1,
31         empty_values/1,cover_letrec_effect/1,
32         receive_effect/1]).
33
34-export([foo/0,foo/1,foo/2,foo/3]).
35
36-include_lib("common_test/include/ct.hrl").
37
38suite() -> [{ct_hooks,[ts_install_cth]}].
39
40all() ->
41    [{group,p}].
42
43groups() ->
44    [{p,[parallel],
45      [t_element,setelement,t_length,append,t_apply,bifs,
46       eq,nested_call_in_case,guard_try_catch,coverage,
47       unused_multiple_values_error,unused_multiple_values,
48       multiple_aliases,redundant_boolean_clauses,
49       mixed_matching_clauses,unnecessary_building,
50       no_no_file,configuration,supplies,
51       redundant_stack_frame,export_from_case,
52       empty_values,cover_letrec_effect,
53       receive_effect]}].
54
55
56init_per_suite(Config) ->
57    test_lib:recompile(?MODULE),
58    Config.
59
60end_per_suite(_Config) ->
61    ok.
62
63init_per_group(_GroupName, Config) ->
64    Config.
65
66end_per_group(_GroupName, Config) ->
67    Config.
68
69
70t_element(Config) when is_list(Config) ->
71    X = make_ref(),
72    X = id(element(1, {X,y,z})),
73    b = id(element(2, {a,b,c,d})),
74    (fun() ->
75	    case {a,#{k=>X}} of
76		{a,#{k:=X}}=Tuple ->
77		    #{k:=X} = id(element(2, Tuple))
78	    end
79    end)(),
80
81    %% No optimization, but should work.
82    Tuple = id({x,y,z}),
83    Pos = id(3),
84    x = id(element(1, Tuple)),
85    c = id(element(Pos, {a,b,c,d})),
86    X = id(element(Pos, {a,b,X,d})),
87    z = id(element(Pos, Tuple)),
88
89    %% Calls that will fail.
90    {'EXIT',{badarg,_}} = (catch element(5, {a,b,c,d})),
91    {'EXIT',{badarg,_}} = (catch element(5, {a,b,X,d})),
92    {'EXIT',{badarg,_}} = (catch element(5.0, {a,b,X,d})),
93    {'EXIT',{badarg,_}} = (catch element(2, not_a_tuple)),
94    {'EXIT',{badarg,_}} = (catch element(2, [])),
95    {'EXIT',{badarg,_}} = (catch element(2, Tuple == 3)),
96    case id({a,b,c}) of
97	{_,_,_}=Tup ->
98	    {'EXIT',{badarg,_}} = (catch element(4, Tup))
99    end,
100    {'EXIT',{badarg,_}} = (catch element(1, tuple_size(Tuple))),
101
102    ok.
103
104setelement(Config) when is_list(Config) ->
105    X = id(b),
106    New = id([1,2,3]),
107    {y,b,c} = id(setelement(1, {a,b,c}, y)),
108    {y,b,c} = id(setelement(1, {a,X,c}, y)),
109    {a,y,c} = id(setelement(2, {a,X,c}, y)),
110    {a,[1,2,3],c} = id(setelement(2, {a,b,c}, New)),
111    {a,[1,2,3],c} = id(setelement(2, {a,X,c}, New)),
112    {a,b,[1,2,3]} = id(setelement(3, {a,b,c}, New)),
113    {a,b,[1,2,3]} = id(setelement(3, {a,X,c}, New)),
114
115    {{d,c,b,a,x}, {z,c,b,a,x}} = setelement_cover(erlang:make_tuple(5, x)),
116
117    {'EXIT',{badarg,_}} = (catch setelement_crash({a,b,c,d,e,f})),
118    error = setelement_crash_2({a,b,c,d,e,f}, <<42>>),
119
120    {'EXIT',{badarg,_}} = (catch setelement(1, not_a_tuple, New)),
121    {'EXIT',{badarg,_}} = (catch setelement(3, {a,b}, New)),
122
123    ok.
124
125setelement_cover(T0) ->
126    T1 = setelement(4, T0, a),
127    T2 = setelement(3, T1, b),
128    T3 = setelement(2, T2, c),
129    T4 = setelement(1, T3, d),
130    T5 = setelement(1, T3, z),
131    {T4,T5}.
132
133setelement_crash(Tuple) ->
134    %% Used to crash the compiler because sys_core_dsetel did not notice that
135    %% X1 was used in bit syntax construction.
136    X1 = setelement(5, Tuple, new),
137    X2 = setelement(3, X1, new),
138    {X2,<<X1>>}.
139
140setelement_crash_2(Tuple, Bin) ->
141    %% Used to crash the compiler because sys_core_dsetel did not notice that
142    %% X1 was used as a size field in bit syntax matching.
143    X1 = setelement(5, Tuple, new),
144    X2 = setelement(3, X1, new),
145    case Bin of
146	<<42:X1>> -> X2;
147	_ -> error
148    end.
149
150t_length(Config) when is_list(Config) ->
151    Blurf = id({blurf,a,b}),
152    Tail = id([42,43,44,45]),
153    0 = id(length([])),
154    1 = id(length([x])),
155    2 = id(length([x,Blurf])),
156    4 = id(length([x,Blurf,a,b])),
157
158    %% No or partial optimization.
159    4 = length(Tail),
160    5 = id(length([x|Tail])),
161
162    %% Will fail.
163    {'EXIT',{badarg,_}} = (catch id(length([a,b|c]))),
164    {'EXIT',{badarg,_}} = (catch id(length([a,Blurf|c]))),
165    {'EXIT',{badarg,_}} = (catch id(length(atom))),
166
167    ok.
168
169-define(APPEND(A, B), (fun(Res) ->
170			       Res = lists:append(A, B),
171			       Res = erlang:append(A, B),
172			       Res = erlang:'++'(A, B)
173		       end)(A++B)).
174
175append(Config) when is_list(Config) ->
176    A = id(0),
177    [a,b,c,d,e,f,g,h,i,j,k] = id(?APPEND([a,b,c,d,e,f],[g,h,i,j,k])),
178    [a,b,c,d,e] = id(?APPEND([a,b,c],id([d,e]))),
179    [0,1,2,3,4,5,6] = id(?APPEND([A,1,2,3],[4,5,6])),
180    {'EXIT',{badarg,_}} = (catch id(?APPEND([A|blurf],[4,5,6]))),
181    ok.
182
183t_apply(Config) when is_list(Config) ->
184    ok = apply(?MODULE, foo, []),
185    4 = apply(?MODULE, foo, [3]),
186    7 = apply(?MODULE, foo, [3,4]),
187    12 = apply(?MODULE, foo, [id(8),4]),
188    21 = apply(?MODULE, foo, [8,id(9),4]),
189    20 = apply(?MODULE, foo, [8,8,id(4)]),
190    24 = apply(?MODULE, foo, [id(10),10,4]),
191
192    M = id(?MODULE),
193    ok = apply(M, foo, []),
194    4 = apply(M, foo, [3]),
195    16.0 = apply(M, foo, [12.0,4]),
196
197    %% Will fail.
198    {'EXIT',{badarg,_}} = (catch apply([a,b,c], foo, [])),
199    {'EXIT',{badarg,_}} = (catch apply(42, foo, [])),
200    {'EXIT',{badarg,_}} = (catch apply(?MODULE, 45, [xx])),
201    {'EXIT',{badarg,_}} = (catch apply(?MODULE, foo, {a,b})),
202    {'EXIT',{badarg,_}} = (catch apply(M, M, [1009|10010])),
203    {'EXIT',{badarg,_}} = (catch apply(?MODULE, foo, [10000|9999])),
204    {'EXIT',{badarg,_}} = (catch apply(?MODULE, foo, a)),
205
206    ok.
207
208foo() ->
209    ok.
210
211foo(A) ->
212    A+1.
213
214foo(A, B) ->
215    A + B.
216
217foo(A, B, C) ->
218    A + B + C.
219
220bifs(Config) when is_list(Config) ->
221    <<1,2,3,4>> = id(list_to_binary([1,2,3,4])),
222    K = {a,key},
223    V = {a,value},
224    {ok,#{K:=V}} = id(list_to_tuple([ok,#{K=>V}])),
225    ok.
226
227-define(CMP_SAME0(A0, B), (fun(A) -> true = A == B, false = A /= B end)(id(A0))).
228-define(CMP_SAME1(A0, B), (fun(A) -> false = A /= B, true = A == B end)(id(A0))).
229-define(CMP_SAME(A0, B), (true = ?CMP_SAME0(A0, B) =:= not ?CMP_SAME1(A0, B))).
230
231-define(CMP_DIFF0(A0, B), (fun(A) -> false = A == B, true = A /= B end)(id(A0))).
232-define(CMP_DIFF1(A0, B), (fun(A) -> true = A /= B, false = A == B end)(id(A0))).
233-define(CMP_DIFF(A0, B), (true = ?CMP_DIFF0(A0, B) =:= not ?CMP_DIFF1(A0, B))).
234
235eq(Config) when is_list(Config) ->
236    ?CMP_SAME([a,b,c], [a,b,c]),
237    ?CMP_SAME([42.0], [42.0]),
238    ?CMP_SAME([42], [42]),
239    ?CMP_SAME([42.0], [42]),
240
241    ?CMP_DIFF(a, [a]),
242    ?CMP_DIFF(a, {1,2,3}),
243
244    ?CMP_SAME(#{a=>1.0,b=>2}, #{b=>2.0,a=>1}),
245    ?CMP_SAME(#{a=>[1.0],b=>[2]}, #{b=>[2.0],a=>[1]}),
246
247    %% The rule for comparing keys are different in 17.x and 18.x.
248    %% Just test that the results are consistent.
249    Bool = id(#{1=>a}) == id(#{1.0=>a}),	%Unoptimizable.
250    Bool = id(#{1=>a}) == #{1.0=>a},		%Optimizable.
251    Bool = #{1=>a} == #{1.0=>a},		%Optimizable.
252    io:format("Bool = ~p\n", [Bool]),
253
254    ok.
255
256%% OTP-7117.
257nested_call_in_case(Config) when is_list(Config) ->
258    PrivDir = proplists:get_value(priv_dir, Config),
259    Dir = test_lib:get_data_dir(Config),
260    Core = filename:join(Dir, "nested_call_in_case"),
261    Opts = [from_core,{outdir,PrivDir}|test_lib:opt_opts(?MODULE)],
262    io:format("~p", [Opts]),
263    {ok,Mod} = c:c(Core, Opts),
264    yes = Mod:a([1,2,3], 2),
265    no = Mod:a([1,2,3], 4),
266    {'EXIT',_} = (catch Mod:a(not_a_list, 42)),
267    _ = code:delete(Mod),
268    _ = code:purge(Mod),
269    ok.
270
271guard_try_catch(_Config) ->
272    false = do_guard_try_catch(key, value),
273    value = get(key),
274    ok.
275
276do_guard_try_catch(K, V) ->
277    %% This try...catch block looks like a guard.
278    %% Make sure that it is not optimized like a guard
279    %% (the put/2 call must not be optimized away).
280    try
281	put(K, V),
282	false
283    catch
284	_:_ ->
285	    false
286    end.
287
288-record(cover_opt_guard_try, {list=[]}).
289
290coverage(Config) when is_list(Config) ->
291    {'EXIT',{{case_clause,{a,b,c}},_}} =
292	(catch cover_will_match_list_type({a,b,c})),
293    {'EXIT',{{case_clause,{a,b,c,d}},_}} =
294	(catch cover_will_match_list_type({a,b,c,d})),
295    a = cover_remove_non_vars_alias({a,b,c}),
296    error = cover_will_match_lit_list(),
297    {ok,[a]} = cover_is_safe_bool_expr(a),
298    false = cover_is_safe_bool_expr2(a),
299    ok = cover_eval_is_function(fun id/1),
300
301    ok = cover_opt_guard_try(#cover_opt_guard_try{list=[a]}),
302    error = cover_opt_guard_try(#cover_opt_guard_try{list=[]}),
303
304    %% Make sure that we don't attempt to make literals
305    %% out of pids. (Putting a pid into a #c_literal{}
306    %% would crash later compiler passes.)
307    case list_to_pid("<0.42.0>") of
308	Pid when is_pid(Pid) -> ok
309    end,
310
311    %% Cover the non-variable case in bsm_do_an/4.
312    ok = bsm_an_inlined(<<1>>, Config),
313    error = bsm_an_inlined(<<1,2,3>>, Config),
314    error = bsm_an_inlined([], Config),
315
316    %% Cover eval_rel_op/4.
317    Tuple = id({a,b}),
318    false = case Tuple of
319		{_,_} ->
320		    Tuple =:= true
321	    end,
322
323    %% Cover is literal_fun/1.
324    {'EXIT',{{case_clause,42},_}} = (catch cover_is_literal_fun()),
325
326    %% Cover core_lib.
327    ok = cover_core_lib([ok,nok]),
328
329    ok.
330
331cover_will_match_list_type(A) ->
332    case A of
333	{a,_,_} ->				%Set type of A to {a,_,_}.
334	    case A of
335		{a,_,_,_} -> ok			%Compare type and pattern.
336	    end
337    end.
338
339%% Make sure the remove_non_vars/4 can handle aliases in the type argument.
340cover_remove_non_vars_alias(X) ->
341    case X of
342	{a=Y,_,_} ->				%Set type of A to {a=Y,_,_}.
343	    case X of
344		{_,_,_} ->			%Compare type and pattern.
345		    Y
346	    end
347    end.
348
349cover_will_match_lit_list() ->
350    case {1,2,3} of				%Literal case expression.
351	{_,$A,$A} ->				%Pattern that does not match.
352	    ok;
353	_ ->
354	    error
355    end.
356
357cover_is_safe_bool_expr(X) ->
358    %% Use a try...catch that looks like a try...catch in a guard.
359    try
360	%% let V = [X] in {ok,V}
361	%%    is_safe_simple([X]) ==> true
362	%%    is_safe_bool_expr([X]) ==> false
363	V = [X],
364	{ok,V}
365    catch
366	_:_ ->
367	    false
368    end.
369
370cover_is_safe_bool_expr2(X) ->
371    try
372	V = [X],
373    is_function(V, 1)
374    catch
375	_:_ ->
376	    false
377    end.
378
379cover_opt_guard_try(Msg) ->
380    if
381	length(Msg#cover_opt_guard_try.list) =/= 1 ->
382	    error;
383	true ->
384	    ok
385    end.
386
387cover_eval_is_function(X) ->
388    case X of
389        {a,_} -> is_function(X);
390        _ -> ok
391    end.
392
393bsm_an_inlined(<<_:8>>, _) -> ok;
394bsm_an_inlined(_, _) -> error.
395
396cover_is_literal_fun() ->
397    [case id(42) of
398         [] ->
399             try right of
400                 wrong -> true
401             catch
402                 error:_ -> error
403             end
404     end]().
405
406cover_core_lib(Modules) ->
407    R = id(Modules),
408    _ = [id(Error) || Error <- R, element(1, Error) =/= ok],
409    ok.
410
411unused_multiple_values_error(Config) when is_list(Config) ->
412    PrivDir = proplists:get_value(priv_dir, Config),
413    Dir = test_lib:get_data_dir(Config),
414    Core = filename:join(Dir, "unused_multiple_values_error"),
415    Opts = [no_copt,clint,ssalint,return,from_core,{outdir,PrivDir}
416	   |test_lib:opt_opts(?MODULE)],
417    {error,[{"unused_multiple_values_error",
418	     [{none,core_lint,{return_mismatch,{hello,1}}}]}],
419     []} = c:c(Core, Opts),
420    ok.
421
422unused_multiple_values(Config) when is_list(Config) ->
423    put(unused_multiple_values, []),
424    [false] = test_unused_multiple_values(false),
425    [b,a,{a,b},false] = test_unused_multiple_values({a,b}),
426    ok.
427
428test_unused_multiple_values(X) ->
429    ok = do_unused_multiple_values(X),
430    get(unused_multiple_values).
431
432do_unused_multiple_values(X) ->
433    case do_something(X) of
434        false ->
435            A = false;
436        Res ->
437            {A,B} = Res,
438            do_something(A),
439            do_something(B)
440    end,
441    _ThisShouldNotFail = A,
442    ok.
443
444do_something(I) ->
445    put(unused_multiple_values,
446	[I|get(unused_multiple_values)]),
447    I.
448
449
450%% Make sure that multiple aliases does not cause
451%% the case expression to be evaluated twice.
452multiple_aliases(Config) when is_list(Config) ->
453    do_ma(fun() ->
454		  X = Y = run_once(),
455		  {X,Y}
456	  end, {ok,ok}),
457    do_ma(fun() ->
458		  case {true,run_once()} of
459		      {true=A=B,ok=X=Y} ->
460			  {A,B,X,Y}
461		  end
462	  end, {true,true,ok,ok}),
463    ok.
464
465do_ma(Fun, Expected) when is_function(Fun, 0) ->
466    Expected = Fun(),
467    ran_once = erase(run_once),
468    ok.
469
470run_once() ->
471    undefined = put(run_once, ran_once),
472    ok.
473
474
475redundant_boolean_clauses(Config) when is_list(Config) ->
476  X = id(0),
477  yes = case X == 0 of
478            false -> no;
479            false -> no;
480            true -> yes
481        end.
482
483mixed_matching_clauses(Config) when is_list(Config) ->
484  0 = case #{} of
485          #{} -> 0;
486          a -> 1
487      end,
488  0 = case <<>> of
489          <<>> -> 0;
490          a -> 1
491      end,
492  ok.
493
494unnecessary_building(Config) when is_list(Config) ->
495    Term1 = do_unnecessary_building_1(test_lib:id(a)),
496    [{a,a},{a,a}] = Term1,
497    7 = erts_debug:size(Term1),
498
499    %% The Input term should not be rebuilt (thus, it should
500    %% only be counted once in the size of the combined term).
501    Input = test_lib:id({a,b,c}),
502    Term2 = test_lib:id(do_unnecessary_building_2(Input)),
503    {b,[{a,b,c},none],x} = Term2,
504    4+4+4+2 = erts_debug:size([Term2|Input]),
505
506    ok.
507
508do_unnecessary_building_1(S) ->
509    %% The tuple must only be built once.
510    F0 = F1 = {S,S},
511    [F0,F1].
512
513do_unnecessary_building_2({a,_,_}=T) ->
514    %% The T term should not be rebuilt.
515    {b,
516     [_,_] = [T,none],
517     x}.
518
519%% This test tests that v3_core has provided annotations and that
520%% sys_core_fold retains them, so that warnings produced by
521%% sys_core_fold will have proper filenames and line numbers. Thus, no
522%% "no_file" warnings.
523no_no_file(_Config) ->
524    {'EXIT',{{case_clause,0},_}} = (catch source(true, any)),
525    surgery = (tim(#{reduction => any}))(),
526
527    false = soul(#{[] => true}),
528    {'EXIT',{{case_clause,true},_}} = (catch soul(#{[] => false})),
529
530    ok = experiment(),
531    ok.
532
533source(true, Activities) ->
534    case 0 of
535	Activities when [] ->
536	    Activities
537    end.
538
539tim(#{reduction := _Emergency}) ->
540    try
541	fun() -> surgery end
542    catch
543	_ when [] ->
544	    planet
545    end.
546
547soul(#{[] := Properly}) ->
548    not case true of
549	    Properly -> true;
550	    Properly -> 0
551	end.
552
553experiment() ->
554    case kingdom of
555	_ ->
556	    +case "map" of
557		 _ -> 0.0
558	     end
559    end,
560    ok.
561
562
563%% Make sure we don't try to move a fun into a guard.
564configuration(_Config) ->
565    {'EXIT',_} = (catch configuration()),
566    ok.
567
568configuration() ->
569    [forgotten || Components <- enemy, is_tuple(fun art/0)].
570
571art() ->
572 creating.
573
574%% core_lint would complain after optimization. A call to error/1
575%% must not occur unconditionally in a guard.
576supplies(_Config) ->
577    case ?MODULE of
578	core_fold_inline_SUITE ->
579	    %% Other error behaviour when inlined.
580	    ok;
581	_ ->
582	    {'EXIT',{function_clause,_}} = (catch do_supplies(#{1 => <<1,2,3>>})),
583	    {'EXIT',{function_clause,_}} = (catch do_supplies(#{1 => a})),
584	    {'EXIT',{function_clause,_}} = (catch do_supplies(42)),
585	    ok
586    end.
587
588do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working.
589
590redundant_stack_frame(_Config) ->
591    {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}),
592    {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})),
593    {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})),
594    ok.
595
596do_redundant_stack_frame(Map) ->
597    %% There should not be a stack frame for this function.
598    X = case Map of
599            #{x := X0} ->
600                X0;
601            #{} ->
602                erlang:error({badkey, Map, x})
603        end,
604    Y = case Map of
605            #{y := Y0} ->
606                Y0;
607            #{} ->
608                erlang:error({badkey, Map, y})
609        end,
610    {X, Y}.
611
612%% Cover some clauses in sys_core_fold:remove_first_value/2.
613
614-record(export_from_case, {val}).
615
616export_from_case(_Config) ->
617    a = export_from_case_1(true),
618    b = export_from_case_1(false),
619
620    R = #export_from_case{val=0},
621    {ok,R} = export_from_case_2(false, R),
622    {ok,#export_from_case{val=42}} = export_from_case_2(true, R),
623
624    ok.
625
626export_from_case_1(Bool) ->
627    case Bool of
628        true ->
629            id(42),
630            Result = a;
631        false ->
632            Result = b
633    end,
634    id(Result).
635
636export_from_case_2(Bool, Rec) ->
637    case Bool of
638        false ->
639            Result = Rec;
640        true ->
641            Result = Rec#export_from_case{val=42}
642    end,
643    {ok,Result}.
644
645empty_values(_Config) ->
646    case ?MODULE of
647        core_fold_inline_SUITE ->
648            {'EXIT',_} = (catch do_empty_values());
649        _ ->
650            {'EXIT',{function_clause,_}} = (catch do_empty_values())
651    end,
652    ok.
653
654do_empty_values() when (#{})#{} ->
655    c.
656
657cover_letrec_effect(_Config) ->
658    self() ! {tag,42},
659    _ = try
660            try
661                ignore
662            after
663                receive
664                    {tag,Int}=Term ->
665                        Res = #{k => {Term,<<Int:16>>}},
666                        self() ! Res
667                end
668            end
669        after
670            ok
671        end,
672    receive
673        Any ->
674            #{k := {{tag,42},<<42:16>>}} = Any
675    end,
676    ok.
677
678receive_effect(_Config) ->
679    self() ! whatever,
680    {} = do_receive_effect(),
681    ok.
682
683do_receive_effect() ->
684    {} = receive _ -> {} = {} end.
685
686id(I) -> I.
687