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