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