1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2006-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_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	 init_per_testcase/2,end_per_testcase/2,
25	 dehydrated_itracer/1,nested_tries/1,
26	 seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
27	 unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
28	 map_core_test/1,eval_case/1,bad_boolean_guard/1,
29	 bs_shadowed_size_var/1,
30	 cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1,
31	 cover_v3_kernel_4/1,cover_v3_kernel_5/1,
32         non_variable_apply/1,name_capture/1,fun_letrec_effect/1,
33         get_map_element/1,receive_tests/1,
34         core_lint/1]).
35
36-include_lib("common_test/include/ct.hrl").
37
38-define(comp(N),
39	N(Config) when is_list(Config) -> try_it(N, Config)).
40
41init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
42    Config.
43
44end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
45    ok.
46
47suite() ->
48    [{ct_hooks,[ts_install_cth]},
49     {timetrap,{minutes,5}}].
50
51all() ->
52    [{group,p}].
53
54groups() ->
55    [{p,test_lib:parallel(),
56      [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
57       eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
58       map_core_test,eval_case,bad_boolean_guard,
59       bs_shadowed_size_var,
60       cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3,
61       cover_v3_kernel_4,cover_v3_kernel_5,
62       non_variable_apply,name_capture,fun_letrec_effect,
63       get_map_element,receive_tests,
64       core_lint
65      ]}].
66
67
68init_per_suite(Config) ->
69    test_lib:recompile(?MODULE),
70    Config.
71
72end_per_suite(_Config) ->
73    ok.
74
75init_per_group(_GroupName, Config) ->
76    Config.
77
78end_per_group(_GroupName, Config) ->
79    Config.
80
81
82?comp(dehydrated_itracer).
83?comp(nested_tries).
84?comp(seq_in_guard).
85?comp(make_effect_seq).
86?comp(eval_is_boolean).
87?comp(unsafe_case).
88?comp(nomatch_shadow).
89?comp(reversed_annos).
90?comp(map_core_test).
91?comp(eval_case).
92?comp(bad_boolean_guard).
93?comp(bs_shadowed_size_var).
94?comp(cover_v3_kernel_1).
95?comp(cover_v3_kernel_2).
96?comp(cover_v3_kernel_3).
97?comp(cover_v3_kernel_4).
98?comp(cover_v3_kernel_5).
99?comp(non_variable_apply).
100?comp(name_capture).
101?comp(fun_letrec_effect).
102?comp(get_map_element).
103?comp(receive_tests).
104
105try_it(Mod, Conf) ->
106    Src = filename:join(proplists:get_value(data_dir, Conf),
107			atom_to_list(Mod)),
108    compile_and_load(Src, []),
109    compile_and_load(Src, [no_copt]).
110
111compile_and_load(Src, Opts) ->
112    {ok,Mod,Bin} = compile:file(Src, [from_core,report,time,binary|Opts]),
113    {module,Mod} = code:load_binary(Mod, Mod, Bin),
114    ok = Mod:Mod(),
115    _ = code:delete(Mod),
116    _ = code:purge(Mod),
117    ok.
118
119core_lint(_Config) ->
120    OK = cerl:c_atom(ok),
121    core_lint_function(illegal),
122    core_lint_function(cerl:c_let([OK], OK, OK)),
123    core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(999), OK)),
124    core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(unknown), OK)),
125    core_lint_function(cerl:c_try(OK, [], OK, [], handler)),
126    core_lint_function(cerl:c_apply(cerl:c_var({OK,0}), [OK])),
127
128    core_lint_function([], [OK], OK),
129    core_lint_function([cerl:c_var({cerl:c_char($*),OK})], [], OK),
130
131    core_lint_pattern([cerl:c_var(99),cerl:c_var(99)]),
132    core_lint_pattern([cerl:c_let([cerl:c_var(var)], OK, OK)]),
133    core_lint_bs_pattern([OK]),
134    Flags = cerl:make_list([big,unsigned]),
135    core_lint_bs_pattern([cerl:c_bitstr(cerl:c_var(tail), cerl:c_atom(binary), Flags),
136                          cerl:c_bitstr(cerl:c_var(value), cerl:c_atom(binary), Flags)]),
137
138    BadGuard1 = cerl:c_call(OK, OK, []),
139    BadGuard2 = cerl:c_call(cerl:c_atom(erlang), OK, []),
140    BadGuard3 = cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(is_record), [OK,OK,OK]),
141    PatMismatch = cerl:c_case(cerl:c_nil(),
142                              [cerl:c_clause([], OK),
143                               cerl:c_clause([OK], OK),
144                               cerl:c_clause([OK], BadGuard1, OK),
145                               cerl:c_clause([OK], BadGuard2, OK),
146                               cerl:c_clause([OK], BadGuard3, OK)]),
147    core_lint_function(PatMismatch),
148
149    ok.
150
151core_lint_bs_pattern(Ps) ->
152    core_lint_pattern([cerl:c_binary(Ps)]).
153
154core_lint_pattern(Ps) ->
155    Cs = [cerl:c_clause(Ps, cerl:c_float(42))],
156    core_lint_function(cerl:c_case(cerl:c_nil(), Cs)).
157
158core_lint_function(Body) ->
159    core_lint_function([], [], Body).
160
161core_lint_function(Exports, Attributes, Body) ->
162    ModName = cerl:c_atom(core_lint_test),
163    MainFun = cerl:c_fun([], Body),
164    MainVar = cerl:c_var({main,0}),
165    Mod = cerl:c_module(ModName, Exports, Attributes, [{MainVar,MainFun}]),
166    {error,[{"core_lint_test",Errors}],[]} =
167        compile:forms(Mod, [from_core,clint0,return]),
168    io:format("~p\n", [Errors]),
169    [] = lists:filter(fun({none,core_lint,_}) -> false;
170                         (_) -> true
171                      end, Errors),
172    error = compile:forms(Mod, [from_core,clint0,report]).
173