aboutsummaryrefslogtreecommitdiffstats
path: root/lib/debugger/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/debugger/test')
-rw-r--r--lib/debugger/test/bs_construct_SUITE.erl395
-rw-r--r--lib/debugger/test/bs_match_bin_SUITE.erl141
-rw-r--r--lib/debugger/test/bs_match_int_SUITE.erl206
-rw-r--r--lib/debugger/test/bs_match_misc_SUITE.erl442
-rw-r--r--lib/debugger/test/exception_SUITE.erl249
-rw-r--r--lib/debugger/test/guard_SUITE.erl208
-rw-r--r--lib/debugger/test/lc_SUITE.erl119
7 files changed, 1597 insertions, 163 deletions
diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl
index 5c7d49e951..187c9f53b0 100644
--- a/lib/debugger/test/bs_construct_SUITE.erl
+++ b/lib/debugger/test/bs_construct_SUITE.erl
@@ -19,18 +19,31 @@
-module(bs_construct_SUITE).
+%% Copied from bs_construct_SUITE in the emulator test suite.
+%% The following test cases have been omitted since they don't
+%% make much sense for the debugger:
+%% bs_add
+%% kostis
+
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1,
- coerce_to_float/1]).
+ test1/1, test2/1, test3/1, test4/1, test5/1, testf/1,
+ not_used/1, in_guard/1,
+ mem_leak/1, coerce_to_float/1, bjorn/1,
+ huge_float_field/1, huge_binary/1, system_limit/1, badarg/1,
+ copy_writable_binary/1, dynamic/1,
+ otp_7422/1, zero_width/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- cases().
+ [test1, test2, test3, test4, test5, testf, not_used,
+ in_guard, mem_leak, coerce_to_float, bjorn,
+ huge_float_field, huge_binary, system_limit, badarg,
+ copy_writable_binary, dynamic, otp_7422, zero_width].
groups() ->
[].
@@ -41,11 +54,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-cases() ->
- [test1, test2, test3, test4, test5, testf, not_used,
- in_guard, coerce_to_float].
-
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
Dog = test_server:timetrap(?t:minutes(1)),
@@ -75,7 +83,9 @@ r(L) ->
-define(T(B, L), {B, ??B, L}).
-define(N(B), {B, ??B, unknown}).
--define(FAIL(Expr), ?line {'EXIT',{badarg,_}} = (catch Expr)).
+-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
+
+-define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)).
l(I_13, I_big1) ->
[
@@ -143,7 +153,13 @@ l(I_13, I_big1) ->
native_3798()),
?T(<<32978297842987249827298387697777669766334937:128/native-integer>>,
- native_bignum())
+ native_bignum()),
+
+ %% Unit tests.
+ ?T(<<<<5:3>>/bitstring>>, <<5:3>>),
+ ?T(<<42,<<7:4>>/binary-unit:4>>, <<42,7:4>>),
+ ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>),
+ ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>)
].
@@ -179,7 +195,7 @@ eval_list([{C_bin, Str, Bytes} | Rest], Vars) ->
[{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)]
end.
-one_test({C_bin, E_bin, Str, Bytes}) when list(Bytes) ->
+one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
io:format(" ~s, ~p~n", [Str, Bytes]),
Bin = list_to_binary(Bytes),
if
@@ -222,7 +238,7 @@ one_test({C_bin, E_bin, Str, Result}) ->
ok;
%% For situations where the final bits may not matter, like
%% for floats:
- N when integer(N) ->
+ N when is_integer(N) ->
io:format("Info: compiled and interpreted differ in the"
" last bytes:~n ~p, ~p.~n",
[binary_to_list(C_bin), binary_to_list(E_bin)]),
@@ -248,9 +264,22 @@ equal_lists(A, B, R) ->
false
end.
+fail_check({'EXIT',{badarg,_}}, Str, Vars) ->
+ try evaluate(Str, Vars) of
+ Res ->
+ io:format("Interpreted result: ~p", [Res]),
+ ?t:fail(did_not_fail_in_intepreted_code)
+ catch
+ error:badarg ->
+ ok
+ end;
+fail_check(Res, _, _) ->
+ io:format("Compiled result: ~p", [Res]),
+ ?t:fail(did_not_fail_in_compiled_code).
+
%%% Simple working cases
test1(suite) -> [];
-test1(Config) when list(Config) ->
+test1(Config) when is_list(Config) ->
?line I_13 = i(13),
?line I_big1 = big(1),
?line Vars = [{'I_13', I_13},
@@ -272,7 +301,7 @@ gen_l(N, S, A) ->
[?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))].
test2(suite) -> [];
-test2(Config) when list(Config) ->
+test2(Config) when is_list(Config) ->
?line test2(0, 8, 2#10101010101010101),
?line test2(0, 8, 2#1111111111).
@@ -300,7 +329,7 @@ t3() ->
].
test3(suite) -> [];
-test3(Config) when list(Config) ->
+test3(Config) when is_list(Config) ->
?line Vars = [],
?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)).
@@ -311,7 +340,7 @@ gen_u_l(N, S, A) ->
[?N(<<A:S/little, A:(N-S)/little>>)].
test4(suite) -> [];
-test4(Config) when list(Config) ->
+test4(Config) when is_list(Config) ->
?line test4(0, 16, 2#10101010101010101),
?line test4(0, 16, 2#1111111111).
@@ -333,7 +362,7 @@ gen_b(N, S, A) ->
test5(suite) -> [];
test5(doc) -> ["OTP-3995"];
-test5(Config) when list(Config) ->
+test5(Config) when is_list(Config) ->
?line test5(0, 8, <<73>>),
?line test5(0, 8, <<68>>).
@@ -350,40 +379,63 @@ test5(S, A) ->
%%% Failure cases
testf(suite) -> [];
-testf(Config) when list(Config) ->
- ?FAIL(<<3.14>>),
- ?FAIL(<<<<1,2>>>>),
-
- ?FAIL(<<2.71/binary>>),
- ?FAIL(<<24334/binary>>),
- ?FAIL(<<24334344294788947129487129487219847/binary>>),
-
- ?FAIL(<<<<1,2,3>>/float>>),
+testf(Config) when is_list(Config) ->
+ ?line ?FAIL(<<3.14>>),
+ ?line ?FAIL(<<<<1,2>>>>),
+
+ ?line ?FAIL(<<2.71/binary>>),
+ ?line ?FAIL(<<24334/binary>>),
+ ?line ?FAIL(<<24334344294788947129487129487219847/binary>>),
+ BigInt = id(24334344294788947129487129487219847),
+ ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]),
+ ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]),
+ ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]),
+
+ %% One negative field size, but the sum of field sizes will be 1 byte.
+ %% Make sure that we reject that properly.
+ I_minus_777 = id(-777),
+ I_minus_2047 = id(-2047),
+ ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>,
+ ordsets:from_list([{'I_minus_777',I_minus_777},
+ {'I_minus_2047',I_minus_2047}])),
+ ?line ?FAIL(<<<<1,2,3>>/float>>),
%% Negative field widths.
- testf_1(-8, <<1,2,3,4,5>>),
-
- ?FAIL(<<42:(-16)>>),
- ?FAIL(<<3.14:(-8)/float>>),
- ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>),
- ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>),
- ?FAIL(<<<<23,56,0,2>>:(anka)>>),
+ ?line testf_1(-8, <<1,2,3,4,5>>),
+ ?line ?FAIL(<<0:(-(1 bsl 100))>>),
+
+ ?line ?FAIL(<<42:(-16)>>),
+ ?line ?FAIL(<<3.14:(-8)/float>>),
+ ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>),
+ ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>),
+ ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>),
+ ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>),
+
+ %% Unit failures.
+ ?line ?FAIL(<<<<1:1>>/binary>>),
+ Sz = id(1),
+ ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]),
+ ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>),
+ ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>),
+ ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>),
+ ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>),
ok.
testf_1(W, B) ->
- ?FAIL(<<42:W>>),
- ?FAIL(<<3.14:W/float>>),
- ?FAIL(<<B:W/binary>>).
+ Vars = [{'W',W}],
+ ?FAIL_VARS(<<42:W>>, Vars),
+ ?FAIL_VARS(<<3.14:W/float>>, Vars),
+ ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]).
not_used(doc) ->
"Test that constructed binaries that are not used will still give an exception.";
not_used(Config) when is_list(Config) ->
?line ok = not_used1(3, <<"dum">>),
- ?line ?FAIL(not_used1(3, "dum")),
- ?line ?FAIL(not_used2(444, -2)),
- ?line ?FAIL(not_used2(444, anka)),
- ?line ?FAIL(not_used3(444)),
+ ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")),
+ ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)),
+ ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)),
+ ?line {'EXIT',{badarg,_}} = (catch not_used3(444)),
ok.
not_used1(I, BinString) ->
@@ -398,7 +450,7 @@ not_used3(I) ->
<<I:(-8)>>,
ok.
-in_guard(Config) when list(Config) ->
+in_guard(Config) when is_list(Config) ->
?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5),
?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
@@ -415,6 +467,36 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3;
in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen;
in_guard(_, _, _) -> nope.
+mem_leak(doc) -> "Make sure that construction has no memory leak";
+mem_leak(Config) when is_list(Config) ->
+ ?line B = make_bin(16, <<0>>),
+ ?line mem_leak(1024, B),
+ ok.
+
+mem_leak(0, _) -> ok;
+mem_leak(N, B) ->
+ ?line big_bin(B, <<23>>),
+ ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)),
+ maybe_gc(),
+ mem_leak(N-1, B).
+
+big_bin(B1, B2) ->
+ <<B1/binary,B1/binary,B1/binary,B1/binary,
+ B1/binary,B1/binary,B1/binary,B1/binary,
+ B1/binary,B1/binary,B1/binary,B1/binary,
+ B1/binary,B1/binary,B1/binary,B1/binary,
+ B2/binary>>.
+
+make_bin(0, Acc) -> Acc;
+make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>).
+
+maybe_gc() ->
+ case erlang:system_info(heap_type) of
+ shared -> erlang:garbage_collect();
+ hybrid -> erlang:garbage_collect();
+ private -> ok
+ end.
+
-define(COF(Int0),
?line (fun(Int) ->
true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
@@ -431,7 +513,7 @@ in_guard(_, _, _) -> nope.
nonliteral(X) -> X.
-coerce_to_float(Config) when list(Config) ->
+coerce_to_float(Config) when is_list(Config) ->
?COF(0),
?COF(-1),
?COF(1),
@@ -444,3 +526,232 @@ coerce_to_float(Config) when list(Config) ->
?COF64(298748888888888888888888888883478264866528467367364766666666666666663),
?COF64(-367546729879999999999947826486652846736736476555566666663),
ok.
+
+bjorn(Config) when is_list(Config) ->
+ ?line error = bjorn_1(),
+ ok.
+
+bjorn_1() ->
+ Bitstr = <<7:13>>,
+ try
+ do_something()
+ catch
+ throw:blurf ->
+ ignore
+ end,
+ do_more(Bitstr, 13).
+
+do_more(Bin, Sz) ->
+ %% Previous bug in the bs_bits_to_bytes instruction: The exeption code
+ %% was not set - the previous exception (throw:blurf) would be used,
+ %% causing the catch to slip.
+ try <<Bin:Sz/binary>> of
+ _V -> ok
+ catch
+ error:_ ->
+ error
+ end.
+
+do_something() ->
+ throw(blurf).
+
+huge_float_field(Config) when is_list(Config) ->
+ ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>),
+ ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>),
+ ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>),
+ ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>),
+%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>),
+ ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>),
+%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>),
+ ok.
+
+huge_float_check({'EXIT',{system_limit,_}}) -> ok;
+huge_float_check({'EXIT',{badarg,_}}) -> ok.
+
+huge_binary(Config) when is_list(Config) ->
+ ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>),
+ ok.
+
+system_limit(Config) when is_list(Config) ->
+ WordSize = erlang:system_info(wordsize),
+ BitsPerWord = WordSize * 8,
+ ?line {'EXIT',{system_limit,_}} =
+ (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>),
+ ?line {'EXIT',{system_limit,_}} =
+ (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>),
+ ?line {'EXIT',{system_limit,_}} =
+ (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>),
+
+ case WordSize of
+ 4 ->
+ system_limit_32();
+ 8 ->
+ ok
+ end.
+
+system_limit_32() ->
+ ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>),
+ ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>),
+ ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>),
+ ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>),
+ ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>),
+ ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>),
+ ?line {'EXIT',{system_limit,_}} =
+ (catch <<0:(id(8)),42:(id(536870912))/unit:8>>),
+ ok.
+
+badarg(Config) when is_list(Config) ->
+ %% BEAM will generate a badarg exception for:
+ %% <<0:(id(1 bsl 100)),0:(id(-1))>>
+ %% but the debugger will generate a system_limit exception.
+ %% It does not seems worthwhile to fix the debugger.
+
+ ?line {'EXIT',{badarg,_}} =
+ (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>),
+
+ ok.
+
+copy_writable_binary(Config) when is_list(Config) ->
+ ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)],
+ ok.
+
+copy_writable_binary_1(_) ->
+ ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>,
+ ?line SubBin = make_sub_bin(Bin0),
+ ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier.
+ ?line Pid = spawn(fun() ->
+ copy_writable_binary_holder(Bin0, SubBin)
+ end),
+ ?line Tab = ets:new(holder, []),
+ ?line ets:insert(Tab, {17,Bin0}),
+ ?line ets:insert(Tab, {42,SubBin}),
+ ?line id(<<Bin0/binary,0:(64*1024*8)>>),
+ ?line Pid ! self(),
+ ?line [{17,Bin0}] = ets:lookup(Tab, 17),
+ ?line [{42,Bin0}] = ets:lookup(Tab, 42),
+ receive
+ {Pid,Bin0,Bin0} -> ok;
+ Other ->
+ io:format("Unexpected message: ~p", [Other]),
+ ?line ?t:fail()
+ end,
+ ok.
+
+copy_writable_binary_holder(Bin, SubBin) ->
+ receive
+ Pid ->
+ Pid ! {self(),Bin,SubBin}
+ end.
+
+make_sub_bin(Bin0) ->
+ N = bit_size(Bin0),
+ <<_:17,Bin:N/bitstring,_:5>> = <<(-1):17,Bin0/bitstring,(-1):5>>,
+ Bin = Bin0, %Assertion.
+ Bin.
+
+%% Test that different ways of using bit syntax instructions
+%% give the same result.
+
+dynamic(Config) when is_list(Config) ->
+ ?line dynamic_1(fun dynamic_big/5),
+ ?line dynamic_1(fun dynamic_little/5),
+ ok.
+
+dynamic_1(Dynamic) ->
+ <<Lpad:128>> = erlang:md5([0]),
+ <<Rpad:128>> = erlang:md5([1]),
+ <<Int:128>> = erlang:md5([2]),
+ 8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0).
+
+dynamic_2(129, _, Count) -> Count;
+dynamic_2(Bef, Data, Count0) ->
+ Count = dynamic_3(Bef, 128-Bef, Data, Count0),
+ dynamic_2(Bef+1, Data, Count).
+
+dynamic_3(_, -1, _, Count) -> Count;
+dynamic_3(Bef, N, {Int0,Lpad,Rpad,Dynamic}=Data, Count) ->
+ Int1 = Int0 band ((1 bsl (N+3))-1),
+ Dynamic(Bef, N, Int1, Lpad, Rpad),
+ Dynamic(Bef, N, -Int1, Lpad, Rpad),
+
+ %% OTP-7085: Test a small number in a wide field.
+ Int2 = Int0 band 16#FFFFFF,
+ Dynamic(Bef, N, Int2, Lpad, Rpad),
+ Dynamic(Bef, N, -Int2, Lpad, Rpad),
+ dynamic_3(Bef, N-1, Data, Count+1).
+
+dynamic_big(Bef, N, Int, Lpad, Rpad) ->
+ NumBin = id(<<Int:N>>),
+ MaskedInt = Int band ((1 bsl N) - 1),
+ <<MaskedInt:N>> = NumBin,
+
+ %% Construct the binary in two different ways.
+ Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(128-Bef-N)>>),
+ Bin = <<Lpad:Bef,Int:N,Rpad:(128-Bef-N)>>,
+
+ %% Further verify the result by matching.
+ LpadMasked = Lpad band ((1 bsl Bef) - 1),
+ RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1),
+ Rbits = (128-Bef-N),
+ <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin),
+ ok.
+
+dynamic_little(Bef, N, Int, Lpad, Rpad) ->
+ NumBin = id(<<Int:N/little>>),
+ MaskedInt = Int band ((1 bsl N) - 1),
+ <<MaskedInt:N/little>> = NumBin,
+
+ %% Construct the binary in two different ways.
+ Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(128-Bef-N)/little>>),
+ Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(128-Bef-N)/little>>,
+
+ %% Further verify the result by matching.
+ LpadMasked = Lpad band ((1 bsl Bef) - 1),
+ RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1),
+ Rbits = (128-Bef-N),
+ <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin),
+ ok.
+
+otp_7422(Config) when is_list(Config) ->
+ otp_7422_int(0),
+ otp_7422_bin(0).
+
+otp_7422_int(N) when N < 512 ->
+ T = erlang:make_tuple(N, []),
+ spawn_link(fun() ->
+ id(T),
+ %% A size of field 0 would write one byte beyond
+ %% the current position in the binary. It could
+ %% overwrite the continuation pointer stored on
+ %% the stack if HTOP was equal to E (the stack pointer).
+ id(<<0:(id(0))>>)
+ end),
+ otp_7422_int(N+1);
+otp_7422_int(_) -> ok.
+
+otp_7422_bin(N) when N < 512 ->
+ T = erlang:make_tuple(N, []),
+ Z = id(<<>>),
+ spawn_link(fun() ->
+ id(T),
+ id(<<Z:(id(0))/bits>>)
+ end),
+ otp_7422_bin(N+1);
+otp_7422_bin(_) -> ok.
+
+zero_width(Config) when is_list(Config) ->
+ ?line Z = id(0),
+ Small = id(42),
+ Big = id(1 bsl 128),
+ ?line <<>> = <<Small:Z>>,
+ ?line <<>> = <<Small:0>>,
+ ?line <<>> = <<Big:Z>>,
+ ?line <<>> = <<Big:0>>,
+
+ ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>),
+ ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>),
+ ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>),
+
+ ok.
+
+id(I) -> I.
diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl
index b42b84aef2..5a7c30f16b 100644
--- a/lib/debugger/test/bs_match_bin_SUITE.erl
+++ b/lib/debugger/test/bs_match_bin_SUITE.erl
@@ -24,14 +24,14 @@
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- byte_split_binary/1,bit_split_binary/1]).
+ byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- cases().
+ [byte_split_binary, bit_split_binary, match_huge_bin].
groups() ->
[].
@@ -42,10 +42,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-cases() ->
- [byte_split_binary, bit_split_binary].
-
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
Dog = test_server:timetrap(?t:minutes(1)),
@@ -65,11 +61,12 @@ end_per_suite(Config) when is_list(Config) ->
ok.
byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions.";
-byte_split_binary(suite) -> [];
-byte_split_binary(Config) when list(Config) ->
+byte_split_binary(Config) when is_list(Config) ->
?line L = lists:seq(0, 57),
?line B = mkbin(L),
- ?line byte_split(L, B, size(B)).
+ ?line byte_split(L, B, size(B)),
+ ?line Unaligned = make_unaligned_sub_binary(B),
+ ?line byte_split(L, Unaligned, size(Unaligned)).
byte_split(L, B, Pos) when Pos >= 0 ->
?line Sz1 = Pos,
@@ -78,18 +75,19 @@ byte_split(L, B, Pos) when Pos >= 0 ->
?line B1 = list_to_binary(lists:sublist(L, 1, Pos)),
?line B2 = list_to_binary(lists:nthtail(Pos, L)),
?line byte_split(L, B, Pos-1);
-byte_split(_L, _B, _) -> ok.
+byte_split(_, _, _) -> ok.
bit_split_binary(doc) -> "Tries to split a binary at all positions.";
-bit_split_binary(suite) -> [];
-bit_split_binary(Config) when list(Config) ->
+bit_split_binary(Config) when is_list(Config) ->
Fun = fun(Bin, List, SkipBef, N) ->
?line SkipAft = 8*size(Bin) - N - SkipBef,
- io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]),
- ?line <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin,
+ %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]),
+ ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin,
?line OutBin = make_bin_from_list(List, N)
end,
?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)),
+ ?line bit_split_binary1(Fun,
+ make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))),
ok.
bit_split_binary1(Action, Bin) ->
@@ -99,24 +97,23 @@ bit_split_binary1(Action, Bin) ->
bit_split_binary2(Action, Bin, [_|T]=List, Bef) ->
bit_split_binary3(Action, Bin, List, Bef, size(Bin)*8),
bit_split_binary2(Action, Bin, T, Bef+1);
-bit_split_binary2(_Action, _Bin, [], _Bef) -> ok.
+bit_split_binary2(_, _, [], _) -> ok.
bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft ->
Action(Bin, List, Bef, (Aft-Bef) div 8 * 8),
bit_split_binary3(Action, Bin, List, Bef, Aft-8);
bit_split_binary3(_, _, _, _, _) -> ok.
-make_bin_from_list(_List, 0) ->
- mkbin([]);
+make_bin_from_list(_, 0) -> mkbin([]);
make_bin_from_list(List, N) ->
list_to_binary([make_int(List, 8, 0),
make_bin_from_list(lists:nthtail(8, List), N-8)]).
-make_int(_List, 0, Acc) -> Acc;
+make_int(_, 0, Acc) -> Acc;
make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H).
-bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80);
+bits_to_list([_|T], 0) -> bits_to_list(T, 16#80);
bits_to_list([H|_]=List, Mask) ->
[case H band Mask of
0 -> 0;
@@ -124,5 +121,109 @@ bits_to_list([H|_]=List, Mask) ->
end|bits_to_list(List, Mask bsr 1)];
bits_to_list([], _) -> [].
+mkbin(L) when is_list(L) -> list_to_binary(L).
+
+make_unaligned_sub_binary(Bin0) ->
+ Bin1 = <<0:3,Bin0/binary,31:5>>,
+ Sz = size(Bin0),
+ <<0:3,Bin:Sz/binary,31:5>> = id(Bin1),
+ Bin.
+
+id(I) -> I.
+
+match_huge_bin(Config) when is_list(Config) ->
+ ?line Bin = <<0:(1 bsl 27),13:8>>,
+ ?line skip_huge_bin_1(1 bsl 27, Bin),
+ ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin),
+
+ %% Test overflowing the size of a binary field.
+ ?line nomatch = overflow_huge_bin_skip_32(Bin),
+ ?line nomatch = overflow_huge_bin_32(Bin),
+ ?line nomatch = overflow_huge_bin_skip_64(Bin),
+ ?line nomatch = overflow_huge_bin_64(Bin),
+
+ %% Size in variable
+ ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+
+ ok.
+
+overflow_huge_bin(Bin, [Sz0|Sizes]) ->
+ Sz = id(1 bsl Sz0),
+ case Bin of
+ <<_:Sz/binary-unit:8,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<NewBin:Sz/binary-unit:8,0,_/binary>> ->
+ {error,Sz,size(NewBin)};
+ _ ->
+ overflow_huge_bin(Bin, Sizes)
+ end
+ end;
+overflow_huge_bin(_, []) -> ok.
+
+overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) ->
+ Sz = id(1 bsl Sz0),
+ case Bin of
+ <<_:Sz/binary-unit:128,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<NewBin:Sz/binary-unit:128,0,_/binary>> ->
+ {error,Sz,size(NewBin)};
+ _ ->
+ overflow_huge_bin_unit128(Bin, Sizes)
+ end
+ end;
+overflow_huge_bin_unit128(_, []) -> ok.
+
+skip_huge_bin_1(I, Bin) ->
+ <<_:I/binary-unit:1,13>> = Bin,
+ ok.
-mkbin(L) when list(L) -> list_to_binary(L).
+match_huge_bin_1(I, Bin) ->
+ case Bin of
+ <<Val:I/binary-unit:1,13>> -> size(Val);
+ _ -> nomatch
+ end.
+
+overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32
+overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25
+overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26
+overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27
+overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28
+overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29
+overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30
+overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31
+overflow_huge_bin_skip_32(_) -> nomatch.
+
+overflow_huge_bin_32(<<Bin:4294967296/binary,_/binary>>) -> {1,Bin}; % 1 bsl 32
+overflow_huge_bin_32(<<Bin:33554432/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 25
+overflow_huge_bin_32(<<Bin:67108864/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 26
+overflow_huge_bin_32(<<Bin:134217728/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 27
+overflow_huge_bin_32(<<Bin:268435456/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 28
+overflow_huge_bin_32(<<Bin:536870912/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 29
+overflow_huge_bin_32(<<Bin:1073741824/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 30
+overflow_huge_bin_32(<<Bin:2147483648/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 31
+overflow_huge_bin_32(_) -> nomatch.
+
+overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64
+overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57
+overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58
+overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59
+overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60
+overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61
+overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62
+overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63
+overflow_huge_bin_skip_64(_) -> nomatch.
+
+overflow_huge_bin_64(<<Bin:18446744073709551616/binary,_/binary>>) -> {1,Bin}; % 1 bsl 64
+overflow_huge_bin_64(<<Bin:144115188075855872/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 57
+overflow_huge_bin_64(<<Bin:288230376151711744/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 58
+overflow_huge_bin_64(<<Bin:576460752303423488/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 59
+overflow_huge_bin_64(<<Bin:1152921504606846976/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 60
+overflow_huge_bin_64(<<Bin:2305843009213693952/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 61
+overflow_huge_bin_64(<<Bin:4611686018427387904/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 62
+overflow_huge_bin_64(<<Bin:9223372036854775808/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 63
+overflow_huge_bin_64(_) -> nomatch.
diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl
index 745368fdfc..bff5f8ff65 100644
--- a/lib/debugger/test/bs_match_int_SUITE.erl
+++ b/lib/debugger/test/bs_match_int_SUITE.erl
@@ -19,11 +19,11 @@
-module(bs_match_int_SUITE).
--author('[email protected]').
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1]).
+ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1,
+ match_huge_int/1,bignum/1,unaligned_32_bit/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -32,7 +32,8 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [cases()].
+ [integer, signed_integer, dynamic, more_dynamic, mml,
+ match_huge_int, bignum, unaligned_32_bit].
groups() ->
[].
@@ -43,10 +44,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-cases() ->
- [integer, signed_integer, dynamic, more_dynamic, mml].
-
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
Dog = test_server:timetrap(?t:minutes(4)),
@@ -65,8 +62,7 @@ init_per_suite(Config) when is_list(Config) ->
end_per_suite(Config) when is_list(Config) ->
ok.
-integer(suite) -> [];
-integer(Config) when list(Config) ->
+integer(Config) when is_list(Config) ->
?line 0 = get_int(mkbin([])),
?line 0 = get_int(mkbin([0])),
?line 42 = get_int(mkbin([42])),
@@ -78,22 +74,33 @@ integer(Config) when list(Config) ->
?line 65534 = get_int(mkbin([255,254])),
?line 16776455 = get_int(mkbin([255,253,7])),
?line 4245492555 = get_int(mkbin([253,13,19,75])),
+ ?line 4294967294 = get_int(mkbin([255,255,255,254])),
+ ?line 4294967295 = get_int(mkbin([255,255,255,255])),
?line Eight = [200,1,19,128,222,42,97,111],
?line cmp128(Eight, uint(Eight)),
?line fun_clause(catch get_int(mkbin(seq(1,5)))),
ok.
-get_int(<<I:0>>) -> I;
-get_int(<<I:8>>) -> I;
-get_int(<<I:16>>) -> I;
-get_int(<<I:24>>) -> I;
-get_int(<<I:32>>) -> I.
+get_int(Bin) ->
+ I = get_int1(Bin),
+ get_int(Bin, I).
+
+get_int(Bin0, I) when size(Bin0) < 4 ->
+ Bin = <<0,Bin0/binary>>,
+ I = get_int1(Bin),
+ get_int(Bin, I);
+get_int(_, I) -> I.
+
+get_int1(<<I:0>>) -> I;
+get_int1(<<I:8>>) -> I;
+get_int1(<<I:16>>) -> I;
+get_int1(<<I:24>>) -> I;
+get_int1(<<I:32>>) -> I.
cmp128(<<I:128>>, I) -> equal;
-cmp128(_B, _I) -> not_equal.
+cmp128(_, _) -> not_equal.
-signed_integer(suite) -> [];
-signed_integer(Config) when list(Config) ->
+signed_integer(Config) when is_list(Config) ->
?line {no_match,_} = sint(mkbin([])),
?line {no_match,_} = sint(mkbin([1,2,3])),
?line 127 = sint(mkbin([127])),
@@ -113,7 +120,7 @@ uint(L) -> uint(L, 0).
uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H);
uint([], Acc) -> Acc.
-dynamic(Config) when list(Config) ->
+dynamic(Config) when is_list(Config) ->
dynamic(mkbin([255]), 8),
dynamic(mkbin([255,255]), 16),
dynamic(mkbin([255,255,255]), 24),
@@ -124,7 +131,7 @@ dynamic(Bin, S1) when S1 >= 0 ->
S2 = size(Bin) * 8 - S1,
dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1),
dynamic(Bin, S1-1);
-dynamic(_Bin, _) -> ok.
+dynamic(_, _) -> ok.
dynamic(Bin, S1, S2, A, B) ->
% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]),
@@ -132,25 +139,24 @@ dynamic(Bin, S1, S2, A, B) ->
<<A:S1,B:S2>> ->
io:format("~p ~p ~p ~p\n", [S1,S2,A,B]),
ok;
- _Other ->
- erlang:error(badmatch, [Bin,S1,S2,A,B])
+ _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B])
end.
more_dynamic(doc) -> "Extract integers at different alignments and of different sizes.";
-more_dynamic(Config) when list(Config) ->
+more_dynamic(Config) when is_list(Config) ->
% Unsigned big-endian numbers.
Unsigned = fun(Bin, List, SkipBef, N) ->
SkipAft = 8*size(Bin) - N - SkipBef,
- <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin,
+ <<_:SkipBef,Int:N,_:SkipAft>> = Bin,
Int = make_int(List, N, 0)
end,
?line more_dynamic1(Unsigned, funny_binary(42)),
- % Signed big-endian numbers.
+ %% Signed big-endian numbers.
Signed = fun(Bin, List, SkipBef, N) ->
SkipAft = 8*size(Bin) - N - SkipBef,
- <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin,
+ <<_:SkipBef,Int:N/signed,_:SkipAft>> = Bin,
case make_signed_int(List, N) of
Int -> ok;
Other ->
@@ -162,18 +168,18 @@ more_dynamic(Config) when list(Config) ->
end,
?line more_dynamic1(Signed, funny_binary(43)),
- % Unsigned little-endian numbers.
+ %% Unsigned little-endian numbers.
UnsLittle = fun(Bin, List, SkipBef, N) ->
SkipAft = 8*size(Bin) - N - SkipBef,
- <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin,
+ <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin,
Int = make_int(big_to_little(List, N), N, 0)
end,
?line more_dynamic1(UnsLittle, funny_binary(44)),
- % Signed little-endian numbers.
+ %% Signed little-endian numbers.
SignLittle = fun(Bin, List, SkipBef, N) ->
SkipAft = 8*size(Bin) - N - SkipBef,
- <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin,
+ <<_:SkipBef,Int:N/signed-little,_:SkipAft>> = Bin,
Little = big_to_little(List, N),
Int = make_signed_int(Little, N)
end,
@@ -181,11 +187,6 @@ more_dynamic(Config) when list(Config) ->
ok.
-funny_binary(N) ->
- B0 = erlang:md5([N]),
- {B1,_B2} = split_binary(B0, size(B0) div 2),
- B1.
-
more_dynamic1(Action, Bin) ->
BitList = bits_to_list(binary_to_list(Bin), 16#80),
more_dynamic2(Action, Bin, BitList, 0).
@@ -193,7 +194,7 @@ more_dynamic1(Action, Bin) ->
more_dynamic2(Action, Bin, [_|T]=List, Bef) ->
more_dynamic3(Action, Bin, List, Bef, size(Bin)*8),
more_dynamic2(Action, Bin, T, Bef+1);
-more_dynamic2(_Action, _Bin, [], _Bef) -> ok.
+more_dynamic2(_, _, [], _) -> ok.
more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft ->
%% io:format("~p, ~p", [Bef,Aft-Bef]),
@@ -208,8 +209,8 @@ big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 ->
big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc.
make_signed_int(_List, 0) -> 0;
-make_signed_int([0|_T]=List, N) -> make_int(List, N, 0);
-make_signed_int([1|_T]=List0, N) ->
+make_signed_int([0|_]=List, N) -> make_int(List, N, 0);
+make_signed_int([1|_]=List0, N) ->
List1 = reversed_sublist(List0, N, []),
List2 = two_complement_and_reverse(List1, 1, []),
-make_int(List2, length(List2), 0).
@@ -225,7 +226,7 @@ two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc].
make_int(_List, 0, Acc) -> Acc;
make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H).
-bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80);
+bits_to_list([_|T], 0) -> bits_to_list(T, 16#80);
bits_to_list([H|_]=List, Mask) ->
[case H band Mask of
0 -> 0;
@@ -234,11 +235,134 @@ bits_to_list([H|_]=List, Mask) ->
bits_to_list([], _) -> [].
fun_clause({'EXIT',{function_clause,_}}) -> ok.
-mkbin(L) when list(L) -> list_to_binary(L).
+mkbin(L) when is_list(L) -> list_to_binary(L).
+
+funny_binary(N) ->
+ B0 = erlang:md5([N]),
+ {B1,_B2} = split_binary(B0, byte_size(B0) div 3),
+ B1.
-mml(Config) when list(Config) ->
+mml(Config) when is_list(Config) ->
?line single_byte_binary = mml_choose(<<42>>),
?line multi_byte_binary = mml_choose(<<42,43>>).
mml_choose(<<_A:8>>) -> single_byte_binary;
-mml_choose(<<_A:8, _T/binary>>) -> multi_byte_binary.
+mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary.
+
+match_huge_int(Config) when is_list(Config) ->
+ Sz = 1 bsl 27,
+ ?line Bin = <<0:Sz,13:8>>,
+ ?line skip_huge_int_1(Sz, Bin),
+ ?line 0 = match_huge_int_1(Sz, Bin),
+
+ %% Test overflowing the size of an integer field.
+ ?line nomatch = overflow_huge_int_skip_32(Bin),
+ case erlang:system_info(wordsize) of
+ 4 ->
+ ?line nomatch = overflow_huge_int_32(Bin);
+ 8 ->
+ %% An attempt will be made to allocate heap space for
+ %% the bignum (which will probably fail); only if the
+ %% allocation succeds will the matching fail because
+ %% the binary is too small.
+ ok
+ end,
+ ?line nomatch = overflow_huge_int_skip_64(Bin),
+ ?line nomatch = overflow_huge_int_64(Bin),
+
+ %% Test overflowing the size of an integer field using variables as sizes.
+ ?line Sizes = case erlang:system_info(wordsize) of
+ 4 -> lists:seq(25, 32);
+ 8 -> []
+ end ++ lists:seq(50, 64),
+ ?line ok = overflow_huge_int_unit128(Bin, Sizes),
+
+ ok.
+
+overflow_huge_int_unit128(Bin, [Sz0|Sizes]) ->
+ Sz = id(1 bsl Sz0),
+ case Bin of
+ <<_:Sz/unit:128,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<Var:Sz/unit:128,0,_/binary>> ->
+ {error,Sz,Var};
+ _ ->
+ overflow_huge_int_unit128(Bin, Sizes)
+ end
+ end;
+overflow_huge_int_unit128(_, []) -> ok.
+
+match_huge_int_1(I, Bin) ->
+ <<Int:I,13>> = Bin,
+ Int.
+
+skip_huge_int_1(I, Bin) ->
+ <<_:I,13>> = Bin.
+
+overflow_huge_int_skip_32(<<_:4294967296,0,_/binary>>) -> 1; % 1 bsl 32
+overflow_huge_int_skip_32(<<_:33554432/unit:128,0,_/binary>>) -> 2; % 1 bsl 25
+overflow_huge_int_skip_32(<<_:67108864/unit:64,0,_/binary>>) -> 3; % 1 bsl 26
+overflow_huge_int_skip_32(<<_:134217728/unit:32,0,_/binary>>) -> 4; % 1 bsl 27
+overflow_huge_int_skip_32(<<_:268435456/unit:16,0,_/binary>>) -> 5; % 1 bsl 28
+overflow_huge_int_skip_32(<<_:536870912/unit:8,0,_/binary>>) -> 6; % 1 bsl 29
+overflow_huge_int_skip_32(<<_:1073741824/unit:8,0,_/binary>>) -> 7; % 1 bsl 30
+overflow_huge_int_skip_32(<<_:2147483648/unit:8,0,_/binary>>) -> 8; % 1 bsl 31
+overflow_huge_int_skip_32(_) -> nomatch.
+
+overflow_huge_int_32(<<Int:4294967296,_/binary>>) -> {1,Int}; % 1 bsl 32
+overflow_huge_int_32(<<Int:33554432/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 25
+overflow_huge_int_32(<<Int:67108864/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 26
+overflow_huge_int_32(<<Int:134217728/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 27
+overflow_huge_int_32(<<Int:268435456/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 28
+overflow_huge_int_32(<<Int:536870912/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 29
+overflow_huge_int_32(<<Int:1073741824/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 30
+overflow_huge_int_32(<<Int:2147483648/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 31
+overflow_huge_int_32(_) -> nomatch.
+
+overflow_huge_int_skip_64(<<_:18446744073709551616,_/binary>>) -> 1; % 1 bsl 64
+overflow_huge_int_skip_64(<<_:144115188075855872/unit:128,0,_/binary>>) -> 2; % 1 bsl 57
+overflow_huge_int_skip_64(<<_:288230376151711744/unit:64,0,_/binary>>) -> 3; % 1 bsl 58
+overflow_huge_int_skip_64(<<_:576460752303423488/unit:32,0,_/binary>>) -> 4; % 1 bsl 59
+overflow_huge_int_skip_64(<<_:1152921504606846976/unit:16,0,_/binary>>) -> 5; % 1 bsl 60
+overflow_huge_int_skip_64(<<_:2305843009213693952/unit:8,0,_/binary>>) -> 6; % 1 bsl 61
+overflow_huge_int_skip_64(<<_:4611686018427387904/unit:8,0,_/binary>>) -> 7; % 1 bsl 62
+overflow_huge_int_skip_64(<<_:9223372036854775808/unit:8,0,_/binary>>) -> 8; % 1 bsl 63
+overflow_huge_int_skip_64(_) -> nomatch.
+
+overflow_huge_int_64(<<Int:18446744073709551616,_/binary>>) -> {1,Int}; % 1 bsl 64
+overflow_huge_int_64(<<Int:144115188075855872/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 57
+overflow_huge_int_64(<<Int:288230376151711744/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 58
+overflow_huge_int_64(<<Int:576460752303423488/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 59
+overflow_huge_int_64(<<Int:1152921504606846976/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 60
+overflow_huge_int_64(<<Int:2305843009213693952/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 61
+overflow_huge_int_64(<<Int:4611686018427387904/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 62
+overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 63
+overflow_huge_int_64(_) -> nomatch.
+
+bignum(Config) when is_list(Config) ->
+ ?line Bin = id(<<42,0:1024/unit:8,43>>),
+ ?line <<42:1025/little-integer-unit:8,_:8>> = Bin,
+ ?line <<_:8,43:1025/integer-unit:8>> = Bin,
+
+ ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>),
+ ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin,
+ erlang:garbage_collect(), %Search for holes in debug-build.
+ ok.
+
+unaligned_32_bit(Config) when is_list(Config) ->
+ %% There used to be a risk for heap overflow (fixed in R11B-5).
+ ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>),
+ ?line unaligned_32_bit_verify(L, 1638).
+
+unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) ->
+ [U|unaligned_32_bit_1(T)];
+unaligned_32_bit_1(_) ->
+ [].
+
+unaligned_32_bit_verify([], 0) -> ok;
+unaligned_32_bit_verify([4294967295|T], N) when N > 0 ->
+ unaligned_32_bit_verify(T, N-1).
+
+id(I) -> I.
diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl
index 53d11ba179..5244a358bd 100644
--- a/lib/debugger/test/bs_match_misc_SUITE.erl
+++ b/lib/debugger/test/bs_match_misc_SUITE.erl
@@ -19,18 +19,23 @@
-module(bs_match_misc_SUITE).
--author('[email protected]').
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1]).
+ bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
+ kenneth/1,encode_binary/1,native/1,happi/1,
+ size_var/1,wiger/1,x0_context/1,huge_float_field/1,
+ writable_binary_matched/1,otp_7198/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- cases().
+ [bound_var, bound_tail, t_float, little_float, sean,
+ kenneth, encode_binary, native, happi, size_var, wiger,
+ x0_context, huge_float_field, writable_binary_matched,
+ otp_7198].
groups() ->
[].
@@ -41,9 +46,13 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_suite(Config) when is_list(Config) ->
+ ?line test_lib:interpret(?MODULE),
+ ?line true = lists:member(?MODULE, int:interpreted()),
+ Config.
-cases() ->
- [bound_var, bound_tail, t_float, little_float, sean].
+end_per_suite(Config) when is_list(Config) ->
+ ok.
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
@@ -55,16 +64,8 @@ end_per_testcase(_Case, Config) ->
?t:timetrap_cancel(Dog),
ok.
-init_per_suite(Config) when is_list(Config) ->
- ?line test_lib:interpret(?MODULE),
- ?line true = lists:member(?MODULE, int:interpreted()),
- Config.
-
-end_per_suite(Config) when is_list(Config) ->
- ok.
-
bound_var(doc) -> "Test matching of bound variables.";
-bound_var(Config) when list(Config) ->
+bound_var(Config) when is_list(Config) ->
?line ok = bound_var(42, 13, <<42,13>>),
?line nope = bound_var(42, 13, <<42,255>>),
?line nope = bound_var(42, 13, <<154,255>>),
@@ -74,7 +75,7 @@ bound_var(A, B, <<A:8,B:8>>) -> ok;
bound_var(_, _, _) -> nope.
bound_tail(doc) -> "Test matching of a bound tail.";
-bound_tail(Config) when list(Config) ->
+bound_tail(Config) when is_list(Config) ->
?line ok = bound_tail(<<>>, <<13,14>>),
?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>),
?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>),
@@ -85,7 +86,7 @@ bound_tail(Config) when list(Config) ->
bound_tail(T, <<_:16,T/binary>>) -> ok;
bound_tail(_, _) -> nope.
-t_float(Config) when list(Config) ->
+t_float(Config) when is_list(Config) ->
F = f1(),
G = f_one(),
@@ -98,6 +99,10 @@ t_float(Config) when list(Config) ->
?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)),
?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)),
?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)),
+
+ ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)),
+ ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)),
+
ok.
@@ -110,7 +115,7 @@ match_float(Bin0, Fsz, I) ->
<<_:I,F:Fsz/float,_:Tsz>> = Bin,
F.
-little_float(Config) when list(Config) ->
+little_float(Config) when is_list(Config) ->
F = f2(),
G = f_one(),
@@ -149,7 +154,7 @@ f2() ->
f_one() ->
1.0.
-sean(Config) when list(Config) ->
+sean(Config) when is_list(Config) ->
?line small = sean1(<<>>),
?line small = sean1(<<1>>),
?line small = sean1(<<1,2>>),
@@ -162,5 +167,404 @@ sean(Config) when list(Config) ->
?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)),
ok.
-sean1(<<B/binary>>) when size(B) < 4 -> small;
+sean1(<<B/binary>>) when byte_size(B) < 4 -> small;
sean1(<<1, _B/binary>>) -> large.
+
+kenneth(Config) when is_list(Config) ->
+ {ok,[145,148,113,129,0,0,0,0]} =
+ msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []).
+
+msisdn_internal_storage(<<>>,MSISDN) ->
+ {ok,lists:reverse(MSISDN)};
+msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) ->
+ {ok,lists:reverse(MSISDN)};
+msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when
+ DigitN < 10 ->
+ {ok,lists:reverse([(DigitN bor 2#11110000)|MSISDN])};
+msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when
+ DigitNplus1 < 10,
+ DigitN < 10 ->
+ NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN],
+ msisdn_internal_storage(Rest,NewMSISDN);
+msisdn_internal_storage(_Rest,_MSISDN) ->
+ {fault}. %% Mandatory IE incorrect
+
+encode_binary(Config) when is_list(Config) ->
+ "C2J2QiSc" = encodeBinary(<<11,98,118,66,36,156>>, []),
+ ok.
+
+encodeBinary(<<>>, Output) ->
+ lists:reverse(Output);
+encodeBinary(<<Data:1/binary>>, Output) ->
+ <<DChar1:6, DChar2:2>> = Data,
+ Char1 = getBase64Char(DChar1),
+ Char2 = getBase64Char(DChar2),
+ Char3 = "=",
+ Char4 = "=",
+ NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output,
+ encodeBinary(<<>>, NewOutput);
+encodeBinary(<<Data:2/binary>>, Output) ->
+ <<DChar1:6, DChar2:6, DChar3:4>> = Data,
+ Char1 = getBase64Char(DChar1),
+ Char2 = getBase64Char(DChar2),
+ Char3 = getBase64Char(DChar3),
+ Char4 = "=",
+ NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output,
+ encodeBinary(<<>>, NewOutput);
+encodeBinary(<<Data:3/binary, Rest/binary>>, Output) ->
+ <<DChar1:6, DChar2:6, DChar3:6, DChar4:6>> = Data,
+ Char1 = getBase64Char(DChar1),
+ Char2 = getBase64Char(DChar2),
+ Char3 = getBase64Char(DChar3),
+ Char4 = getBase64Char(DChar4),
+ NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output,
+ encodeBinary(Rest, NewOutput);
+encodeBinary(_Data, _) ->
+ error.
+
+getBase64Char(0) -> "A";
+getBase64Char(1) -> "B";
+getBase64Char(2) -> "C";
+getBase64Char(3) -> "D";
+getBase64Char(4) -> "E";
+getBase64Char(5) -> "F";
+getBase64Char(6) -> "G";
+getBase64Char(7) -> "H";
+getBase64Char(8) -> "I";
+getBase64Char(9) -> "J";
+getBase64Char(10) -> "K";
+getBase64Char(11) -> "L";
+getBase64Char(12) -> "M";
+getBase64Char(13) -> "N";
+getBase64Char(14) -> "O";
+getBase64Char(15) -> "P";
+getBase64Char(16) -> "Q";
+getBase64Char(17) -> "R";
+getBase64Char(18) -> "S";
+getBase64Char(19) -> "T";
+getBase64Char(20) -> "U";
+getBase64Char(21) -> "V";
+getBase64Char(22) -> "W";
+getBase64Char(23) -> "X";
+getBase64Char(24) -> "Y";
+getBase64Char(25) -> "Z";
+getBase64Char(26) -> "a";
+getBase64Char(27) -> "b";
+getBase64Char(28) -> "c";
+getBase64Char(29) -> "d";
+getBase64Char(30) -> "e";
+getBase64Char(31) -> "f";
+getBase64Char(32) -> "g";
+getBase64Char(33) -> "h";
+getBase64Char(34) -> "i";
+getBase64Char(35) -> "j";
+getBase64Char(36) -> "k";
+getBase64Char(37) -> "l";
+getBase64Char(38) -> "m";
+getBase64Char(39) -> "n";
+getBase64Char(40) -> "o";
+getBase64Char(41) -> "p";
+getBase64Char(42) -> "q";
+getBase64Char(43) -> "r";
+getBase64Char(44) -> "s";
+getBase64Char(45) -> "t";
+getBase64Char(46) -> "u";
+getBase64Char(47) -> "v";
+getBase64Char(48) -> "w";
+getBase64Char(49) -> "x";
+getBase64Char(50) -> "y";
+getBase64Char(51) -> "z";
+getBase64Char(52) -> "0";
+getBase64Char(53) -> "1";
+getBase64Char(54) -> "2";
+getBase64Char(55) -> "3";
+getBase64Char(56) -> "4";
+getBase64Char(57) -> "5";
+getBase64Char(58) -> "6";
+getBase64Char(59) -> "7";
+getBase64Char(60) -> "8";
+getBase64Char(61) -> "9";
+getBase64Char(62) -> "+";
+getBase64Char(63) -> "/";
+getBase64Char(_Else) ->
+ %% This is an illegal input.
+% cgLogEM:log(error, ?MODULE, getBase64Char, [Else],
+% "illegal input",
+% ?LINE, version()),
+ "**".
+
+-define(M(F), <<F>> = <<F>>).
+
+native(Config) when is_list(Config) ->
+ ?line ?M(3.14:64/native-float),
+ ?line ?M(333:16/native),
+ ?line ?M(38658345:32/native),
+ case <<1:16/native>> of
+ <<0,1>> -> native_big();
+ <<1,0>> -> native_little()
+ end.
+
+native_big() ->
+ ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>,
+ ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>,
+ {comment,"Big endian"}.
+
+native_little() ->
+ ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>,
+ ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>,
+ {comment,"Little endian"}.
+
+happi(Config) when is_list(Config) ->
+ Bin = <<".123">>,
+ ?line <<"123">> = lex_digits1(Bin, 1, []),
+ ?line <<"123">> = lex_digits2(Bin, 1, []),
+ ok.
+
+lex_digits1(<<$., Rest/binary>>,_Val,_Acc) ->
+ Rest;
+lex_digits1(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 ->
+ lex_digits1(Rest,Val*10+dec(N),Acc);
+lex_digits1(_Other,_Val,_Acc) ->
+ not_ok.
+
+lex_digits2(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 ->
+ lex_digits2(Rest,Val*10+dec(N),Acc);
+lex_digits2(<<$., Rest/binary>>,_Val,_Acc) ->
+ Rest;
+lex_digits2(_Other,_Val,_Acc) ->
+ not_ok.
+
+dec(A) ->
+ A-$0.
+
+size_var(Config) when is_list(Config) ->
+ ?line {<<45>>,<<>>} = split(<<1:16,45>>),
+ ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>),
+ ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>),
+
+ ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>),
+
+ ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>),
+ ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)),
+
+ ?line <<"cdef">> = skip(<<2:8,"abcdef">>),
+
+ ok.
+
+split(<<N:16,B:N/binary,T/binary>>) ->
+ {B,T}.
+
+split(N, <<N:16,B:N/binary,T/binary>>) ->
+ {B,T}.
+
+split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) ->
+ {B,T}.
+
+skip(<<N:8,_:N/binary,T/binary>>) -> T.
+
+wiger(Config) when is_list(Config) ->
+ ?line ok1 = wcheck(<<3>>),
+ ?line ok2 = wcheck(<<1,2,3>>),
+ ?line ok3 = wcheck(<<4>>),
+ ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>),
+ ?line {error,<<>>} = wcheck(<<>>),
+ ok.
+
+wcheck(<<A>>) when A==3->
+ ok1;
+wcheck(<<_,_:2/binary>>) ->
+ ok2;
+wcheck(<<_>>) ->
+ ok3;
+wcheck(Other) ->
+ {error,Other}.
+
+%% Test that having the match context in x(0) works.
+
+x0_context(Config) when is_list(Config) ->
+ x0_0([], <<3.0:64/float,42:16,123456:32>>).
+
+x0_0(_, Bin) ->
+ <<3.0:64/float,42:16,_/binary>> = Bin,
+ x0_1([], Bin, 64, 16, 2).
+
+x0_1(_, Bin, FloatSz, IntSz, BinSz) ->
+ <<_:FloatSz/float,42:IntSz,B:BinSz/binary,C:1/binary,D/binary>> = Bin,
+ id({B,C,D}),
+ <<_:FloatSz/float,42:IntSz,B:BinSz/binary,_/binary>> = Bin,
+ x0_2([], Bin).
+
+x0_2(_, Bin) ->
+ <<_:64,0:7,42:9,_/binary>> = Bin,
+ x0_3([], Bin).
+
+x0_3(_, Bin) ->
+ case Bin of
+ <<_:72,7:8,_/binary>> ->
+ ?line ?t:fail();
+ <<_:64,0:16,_/binary>> ->
+ ?line ?t:fail();
+ <<_:64,42:16,123456:32,_/binary>> ->
+ ok
+ end.
+
+
+huge_float_field(Config) when is_list(Config) ->
+ Sz = 1 bsl 27,
+ ?line Bin = <<0:Sz>>,
+
+ ?line nomatch = overflow_huge_float_skip_32(Bin),
+ ?line nomatch = overflow_huge_float_32(Bin),
+
+ ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ok.
+
+overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32
+overflow_huge_float_skip_32(<<_:33554432/float-unit:128,0,_/binary>>) -> 2; % 1 bsl 25
+overflow_huge_float_skip_32(<<_:67108864/float-unit:64,0,_/binary>>) -> 3; % 1 bsl 26
+overflow_huge_float_skip_32(<<_:134217728/float-unit:32,0,_/binary>>) -> 4; % 1 bsl 27
+overflow_huge_float_skip_32(<<_:268435456/float-unit:16,0,_/binary>>) -> 5; % 1 bsl 28
+overflow_huge_float_skip_32(<<_:536870912/float-unit:8,0,_/binary>>) -> 6; % 1 bsl 29
+overflow_huge_float_skip_32(<<_:1073741824/float-unit:8,0,_/binary>>) -> 7; % 1 bsl 30
+overflow_huge_float_skip_32(<<_:2147483648/float-unit:8,0,_/binary>>) -> 8; % 1 bsl 31
+overflow_huge_float_skip_32(_) -> nomatch.
+
+overflow_huge_float_32(<<F:4294967296/float,_/binary>>) -> {1,F}; % 1 bsl 32
+overflow_huge_float_32(<<F:33554432/float-unit:128,0,_/binary>>) -> {2,F}; % 1 bsl 25
+overflow_huge_float_32(<<F:67108864/float-unit:128,0,_/binary>>) -> {3,F}; % 1 bsl 26
+overflow_huge_float_32(<<F:134217728/float-unit:128,0,_/binary>>) -> {4,F}; % 1 bsl 27
+overflow_huge_float_32(<<F:268435456/float-unit:128,0,_/binary>>) -> {5,F}; % 1 bsl 28
+overflow_huge_float_32(<<F:536870912/float-unit:128,0,_/binary>>) -> {6,F}; % 1 bsl 29
+overflow_huge_float_32(<<F:1073741824/float-unit:128,0,_/binary>>) -> {7,F}; % 1 bsl 30
+overflow_huge_float_32(<<F:2147483648/float-unit:128,0,_/binary>>) -> {8,F}; % 1 bsl 31
+overflow_huge_float_32(_) -> nomatch.
+
+
+overflow_huge_float(Bin, [Sz0|Sizes]) ->
+ Sz = id(1 bsl Sz0),
+ case Bin of
+ <<_:Sz/float-unit:8,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<Var:Sz/float-unit:8,0,_/binary>> ->
+ {error,Sz,Var};
+ _ ->
+ overflow_huge_float(Bin, Sizes)
+ end
+ end;
+overflow_huge_float(_, []) -> ok.
+
+overflow_huge_float_unit128(Bin, [Sz0|Sizes]) ->
+ Sz = id(1 bsl Sz0),
+ case Bin of
+ <<_:Sz/float-unit:128,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<Var:Sz/float-unit:128,0,_/binary>> ->
+ {error,Sz,Var};
+ _ ->
+ overflow_huge_float_unit128(Bin, Sizes)
+ end
+ end;
+overflow_huge_float_unit128(_, []) -> ok.
+
+
+%%
+%% Test that a writable binary can be safely matched.
+%%
+
+writable_binary_matched(Config) when is_list(Config) ->
+ ?line WritableBin = create_writeable_binary(),
+ ?line writable_binary_matched(WritableBin, WritableBin, 500).
+
+writable_binary_matched(<<0>>, _, N) ->
+ if
+ N =:= 0 -> ok;
+ true ->
+ put(grow_heap, [N|get(grow_heap)]),
+ ?line WritableBin = create_writeable_binary(),
+ ?line writable_binary_matched(WritableBin, WritableBin, N-1)
+ end;
+writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) ->
+ ?line WritableBin = writable_binary(WritableBin0, B),
+ writable_binary_matched(T, WritableBin, N).
+
+writable_binary(WritableBin0, B) when is_binary(WritableBin0) ->
+ %% Heavy append to force the binary to move.
+ ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>,
+ ?line id(<<(id(0)):128/unit:8>>),
+ WritableBin.
+
+create_writeable_binary() ->
+ <<(id(<<>>))/binary,1,2,3,4,5,6,0>>.
+
+otp_7198(Config) when is_list(Config) ->
+ %% When a match context was reused, and grown at the same time to
+ %% increase the number of saved positions, the thing word was not updated
+ %% to account for the new size. Therefore, if there was a garbage collection,
+ %% the new slots would be included in the garbage collection.
+ ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)],
+ ok.
+
+do_otp_7198(FillerSize) ->
+ Filler = erlang:make_tuple(FillerSize, 42),
+ {Pid,Ref} = spawn_monitor(fun() -> do_otp_7198_test(Filler) end),
+ receive
+ {'DOWN',Ref,process,Pid,normal} ->
+ ok;
+ {'DOWN',Ref,process,Pid,Reason} ->
+ io:format("unexpected: ~p", [Reason]),
+ ?line ?t:fail()
+ end.
+
+do_otp_7198_test(_) ->
+ [{'KEYWORD',114},
+ {'KEYWORD',101},
+ {'KEYWORD',103},
+ {'KEYWORD',105},
+ {'KEYWORD',111},
+ {'FIELD',110},
+ {'KEYWORD',119},
+ {'KEYWORD',104},
+ {'KEYWORD',97},
+ {'KEYWORD',116},
+ {'KEYWORD',101},
+ {'KEYWORD',118},
+ {'KEYWORD',101},
+ {'KEYWORD',114},
+ '$thats_all_folks$'] = otp_7198_scan(<<"region:whatever">>, []).
+
+
+otp_7198_scan(<<>>, TokAcc) ->
+ lists:reverse(['$thats_all_folks$' | TokAcc]);
+
+otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when
+ (D =:= $D orelse D =:= $d) and
+ ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) ->
+ otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]);
+
+otp_7198_scan(<<D>>, TokAcc) when
+ (D =:= $D) or (D =:= $d) ->
+ otp_7198_scan(<<>>, ['AND' | TokAcc]);
+
+otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when
+ (N =:= $N orelse N =:= $n) and
+ ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) ->
+ otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]);
+
+otp_7198_scan(<<C, Rest/binary>>, TokAcc) when
+ (C >= $A) and (C =< $Z);
+ (C >= $a) and (C =< $z);
+ (C >= $0) and (C =< $9) ->
+ case Rest of
+ <<$:, R/binary>> ->
+ otp_7198_scan(R, [{'FIELD', C} | TokAcc]);
+ _ ->
+ otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
+ end.
+
+
+id(I) -> I.
diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl
index 8c864e4b5f..d2779d943a 100644
--- a/lib/debugger/test/exception_SUITE.erl
+++ b/lib/debugger/test/exception_SUITE.erl
@@ -23,7 +23,8 @@
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- badmatch/1,pending_errors/1,nil_arith/1]).
+ badmatch/1,pending_errors/1,nil_arith/1,
+ stacktrace/1,nested_stacktrace/1,raise/1,gunilla/1,per/1]).
-export([bad_guy/2]).
@@ -45,7 +46,8 @@ end_per_group(_GroupName, Config) ->
cases() ->
- [badmatch, pending_errors, nil_arith].
+ [badmatch, pending_errors, nil_arith, stacktrace,
+ nested_stacktrace, raise, gunilla, per].
-define(try_match(E),
catch ?MODULE:bar(),
@@ -69,9 +71,9 @@ init_per_suite(Config) when is_list(Config) ->
end_per_suite(Config) when is_list(Config) ->
ok.
-badmatch(doc) -> "Test that deliberately bad matches are reported correctly.";
-badmatch(suite) -> [];
-badmatch(Config) when list(Config) ->
+%% Test that deliberately bad matches are reported correctly.
+
+badmatch(Config) when is_list(Config) ->
?line ?try_match(a),
?line ?try_match(42),
?line ?try_match({a, b, c}),
@@ -79,11 +81,9 @@ badmatch(Config) when list(Config) ->
?line ?try_match(1.0),
ok.
-pending_errors(doc) ->
- ["Test various exceptions, in the presence of a previous error suppressed ",
- "in a guard."];
-pending_errors(suite) -> [];
-pending_errors(Config) when list(Config) ->
+%% Test various exceptions, in the presence of a previous error suppressed
+%% in a guard.
+pending_errors(Config) when is_list(Config) ->
?line pending(e_badmatch, {badmatch, b}),
?line pending(x, function_clause),
?line pending(e_case, {case_clause, xxx}),
@@ -100,7 +100,7 @@ bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed)
bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed)
ok;
bad_guy(_, e_case) ->
- case xxx of
+ case id(xxx) of
ok -> ok
end; % case_clause
bad_guy(_, e_if) ->
@@ -121,7 +121,7 @@ bad_guy(_, e_badarg) ->
bad_guy(_, e_badarg_spawn) ->
spawn({}, {}, {}); % badarg
bad_guy(_, e_badmatch) ->
- a = b. % badmatch
+ a = id(b). % badmatch
pending(Arg, Expected) ->
pending(pe_badarith, Arg, Expected),
@@ -155,28 +155,21 @@ pending_exit_message(Args, Expected) ->
end,
process_flag(trap_exit, false).
-pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code)
- when atom(Bif), list(BifArgs), length(Args) == Arity -> %Threaded code.
- ok;
-pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Args}|_]}, Func, Args, _Code)
- when atom(Bif), list(BifArgs) -> %From interpreted code.
+pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code)
+ when is_atom(Bif), is_list(BifArgs), length(Args) == Arity ->
ok;
pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) ->
ok;
pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) ->
ok;
-pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> %Threaded code
+pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity ->
ok;
-pending({Code,[{?MODULE,Func,Args}|_]}, Func, Args, Code) -> %From interpreted code.
- ok;
-pending(Reason, Func, Args, Code) ->
- test_server:fail({bad_exit_reason,Reason,{Func,Args,Code}}).
-
-nil_arith(doc) ->
- "Test that doing arithmetics on [] gives a badarith EXIT and not a crash.";
-nil_arith(suite) ->
- [];
-nil_arith(Config) when list(Config) ->
+pending(Reason, _Function, _Args, _Code) ->
+ test_server:fail({bad_exit_reason,Reason}).
+
+%% Test that doing arithmetics on [] gives a badarith EXIT and not a crash.
+
+nil_arith(Config) when is_list(Config) ->
?line ba_plus_minus_times([], []),
?line ba_plus_minus_times([], 0),
@@ -268,3 +261,203 @@ ba_shift(A, B) ->
ba_bnot(A) ->
io:format("bnot ~p", [A]),
{'EXIT', {badarith, _}} = (catch bnot A).
+
+stacktrace(Conf) when is_list(Conf) ->
+ Tag = make_ref(),
+ ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end),
+ ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end,
+ V = [make_ref()|self()],
+ ?line {value2,{caught1,badarg,[{erlang,abs,[V]}|_]=St1}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ ?line St1 = erase(stacktrace1),
+ ?line St1 = erase(stacktrace2),
+ ?line St1 = erlang:get_stacktrace(),
+ ?line {caught2,{error,badarith},[{?MODULE,my_add,2}|_]=St2} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}),
+ ?line [{?MODULE,my_div,2}|_] = erase(stacktrace1),
+ ?line St2 = erase(stacktrace2),
+ ?line St2 = erlang:get_stacktrace(),
+ ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3}|_]=St3} =
+ stacktrace_1({value,V}, error, {value,V}),
+ ?line St3 = erase(stacktrace1),
+ ?line St3 = erase(stacktrace2),
+ ?line St3 = erlang:get_stacktrace(),
+ ?line {caught2,{throw,V},[{?MODULE,foo,1}|_]=St4} =
+ stacktrace_1({value,V}, error, {throw,V}),
+ ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1),
+ ?line St4 = erase(stacktrace2),
+ ?line St4 = erlang:get_stacktrace(),
+ ok.
+
+stacktrace_1(X, C1, Y) ->
+ erase(stacktrace1),
+ erase(stacktrace2),
+ try try foo(X) of
+ C1 -> value1
+ catch
+ C1:D1 -> {caught1,D1,erlang:get_stacktrace()}
+ after
+ put(stacktrace1, erlang:get_stacktrace()),
+ foo(Y)
+ end of
+ V2 -> {value2,V2}
+ catch
+ C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()}
+ after
+ put(stacktrace2, erlang:get_stacktrace())
+ end.
+
+
+
+nested_stacktrace(Conf) when is_list(Conf) ->
+ V = [{make_ref()}|[self()]],
+ ?line value1 =
+ nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
+ {void,void,void}),
+ ?line {caught1,
+ [{?MODULE,my_add,2}|_],
+ value2,
+ [{?MODULE,my_add,2}|_]} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ ?line {caught1,
+ [{?MODULE,my_add,2}|_],
+ {caught2,[{erlang,abs,[V]}|_]},
+ [{erlang,abs,[V]}|_]} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg}),
+ ok.
+
+nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
+ try foo(X1) of
+ V1 -> value1
+ catch
+ C1:V1 ->
+ S1 = erlang:get_stacktrace(),
+ T2 =
+ try foo(X2) of
+ V2 -> value2
+ catch
+ C2:V2 -> {caught2,erlang:get_stacktrace()}
+ end,
+ {caught1,S1,T2,erlang:get_stacktrace()}
+ end.
+
+
+
+raise(Conf) when is_list(Conf) ->
+ ?line erase(raise),
+ ?line A =
+ try
+ ?line try foo({'div',{1,0}})
+ catch
+ error:badarith ->
+ put(raise, A0 = erlang:get_stacktrace()),
+ ?line erlang:raise(error, badarith, A0)
+ end
+ catch
+ error:badarith ->
+ ?line A1 = erlang:get_stacktrace(),
+ ?line A1 = get(raise)
+ end,
+ ?line A = erlang:get_stacktrace(),
+ ?line A = get(raise),
+ ?line [{?MODULE,my_div,2}|_] = A,
+ %%
+ N = 8, % Must be even
+ ?line N = erlang:system_flag(backtrace_depth, N),
+ ?line try even(N)
+ catch error:function_clause -> ok
+ end,
+ ?line B = odd_even(N, []),
+ ?line B = erlang:get_stacktrace(),
+ %%
+ ?line C0 = odd_even(N+1, []),
+ ?line C = lists:sublist(C0, N),
+ ?line try odd(N+1)
+ catch error:function_clause -> ok
+ end,
+ ?line C = erlang:get_stacktrace(),
+ ?line try erlang:raise(error, function_clause, C0)
+ catch error:function_clause -> ok
+ end,
+ ?line C = erlang:get_stacktrace(),
+ ok.
+
+odd_even(N, R) when is_integer(N), N > 1 ->
+ odd_even(N-1,
+ [if (N rem 2) == 0 ->
+ {?MODULE,even,1};
+ true ->
+ {?MODULE,odd,1}
+ end|R]);
+odd_even(1, R) ->
+ [{?MODULE,odd,[1]}|R].
+
+even(N) when is_integer(N), N > 1, (N rem 2) == 0 ->
+ odd(N-1)++[N].
+
+odd(N) when is_integer(N), N > 1, (N rem 2) == 1 ->
+ even(N-1)++[N].
+
+
+foo({value,Value}) -> Value;
+foo({'div',{A,B}}) ->
+ my_div(A, B);
+foo({'add',{A,B}}) ->
+ my_add(A, B);
+foo({'abs',X}) ->
+ my_abs(X);
+foo({error,Error}) ->
+ erlang:error(Error);
+foo({throw,Throw}) ->
+ erlang:throw(Throw);
+foo({exit,Exit}) ->
+ erlang:exit(Exit);
+foo({raise,{Class,Reason,Stacktrace}}) ->
+ erlang:raise(Class, Reason, Stacktrace).
+%%foo(function_clause) -> % must not be defined!
+
+my_div(A, B) ->
+ A div B.
+
+my_add(A, B) ->
+ A + B.
+
+my_abs(X) -> abs(X).
+
+gunilla(Config) when is_list(Config) ->
+ ?line {throw,kalle} = gunilla_1(),
+ ?line [] = erlang:get_stacktrace(),
+ ok.
+
+gunilla_1() ->
+ try try arne()
+ after
+ pelle
+ end
+ catch
+ C:R ->
+ {C,R}
+ end.
+
+arne() ->
+ %% Empty stack trace used to cause change the error class to 'error'.
+ erlang:raise(throw, kalle, []).
+
+per(Config) when is_list(Config) ->
+ try
+ t1(0,pad,0),
+ t2(0,pad,0)
+ catch
+ error:badarith ->
+ ok
+ end.
+
+t1(_,X,_) ->
+ (1 bsl X) + 1.
+
+t2(_,X,_) ->
+ (X bsl 1) + 1.
+
+id(I) -> I.
diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl
index 611dcb4dff..31925491a6 100644
--- a/lib/debugger/test/guard_SUITE.erl
+++ b/lib/debugger/test/guard_SUITE.erl
@@ -35,7 +35,8 @@
t_is_boolean/1,is_function_2/1,
tricky/1,rel_ops/1,
basic_andalso_orelse/1,traverse_dcd/1,
- check_qlc_hrl/1]).
+ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
+ bad_constants/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -65,7 +66,8 @@ cases() ->
xor_guard, more_xor_guards, build_in_guard,
old_guard_tests, gbif, t_is_boolean, is_function_2,
tricky, rel_ops, basic_andalso_orelse, traverse_dcd,
- check_qlc_hrl].
+ check_qlc_hrl, andalso_semi, t_tuple_size, binary_part,
+ bad_constants].
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
@@ -1477,8 +1479,208 @@ cqlc(M, F, As, St) ->
St
end.
+%% OTP-7679: Thanks to Hunter Morris.
+andalso_semi(Config) when is_list(Config) ->
+ ?line ok = andalso_semi_foo(0),
+ ?line ok = andalso_semi_foo(1),
+ ?line fc(catch andalso_semi_foo(2)),
+
+ ?line ok = andalso_semi_bar([a,b,c]),
+ ?line ok = andalso_semi_bar(1),
+ ?line fc(catch andalso_semi_bar([a,b])),
+ ok.
+
+andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 ->
+ ok.
+
+andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 ->
+ ok.
+
+
+t_tuple_size(Config) when is_list(Config) ->
+ ?line 10 = do_tuple_size({1,2,3,4}),
+ ?line fc(catch do_tuple_size({1,2,3})),
+ ?line fc(catch do_tuple_size(42)),
+
+ ?line error = ludicrous_tuple_size({a,b,c}),
+ ?line error = ludicrous_tuple_size([a,b,c]),
+
+ ok.
+
+do_tuple_size(T) when tuple_size(T) =:= 4 ->
+ {A,B,C,D} = T,
+ A+B+C+D.
+
+ludicrous_tuple_size(T)
+ when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok;
+ludicrous_tuple_size(T)
+ when tuple_size(T) =:= 16#10000000000000000 -> ok;
+ludicrous_tuple_size(T)
+ when tuple_size(T) =:= (1 bsl 64) - 1 -> ok;
+ludicrous_tuple_size(T)
+ when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok;
+ludicrous_tuple_size(_) -> error.
+
+%%
+%% The binary_part/2,3 guard BIFs
+%%
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+binary_part(doc) ->
+ ["Tests the binary_part/2,3 guard (GC) bif's"];
+binary_part(Config) when is_list(Config) ->
+ %% This is more or less a copy of what the guard_SUITE in emulator
+ %% does to cover the guard bif's
+ ?line 1 = bptest(<<1,2,3>>),
+ ?line 2 = bptest(<<2,1,3>>),
+ ?line error = bptest(<<1>>),
+ ?line error = bptest(<<>>),
+ ?line error = bptest(apa),
+ ?line 3 = bptest(<<2,3,3>>),
+ % With one variable (pos)
+ ?line 1 = bptest(<<1,2,3>>,1),
+ ?line 2 = bptest(<<2,1,3>>,1),
+ ?line error = bptest(<<1>>,1),
+ ?line error = bptest(<<>>,1),
+ ?line error = bptest(apa,1),
+ ?line 3 = bptest(<<2,3,3>>,1),
+ % With one variable (length)
+ ?line 1 = bptesty(<<1,2,3>>,1),
+ ?line 2 = bptesty(<<2,1,3>>,1),
+ ?line error = bptesty(<<1>>,1),
+ ?line error = bptesty(<<>>,1),
+ ?line error = bptesty(apa,1),
+ ?line 3 = bptesty(<<2,3,3>>,2),
+ % With one variable (whole tuple)
+ ?line 1 = bptestx(<<1,2,3>>,{1,1}),
+ ?line 2 = bptestx(<<2,1,3>>,{1,1}),
+ ?line error = bptestx(<<1>>,{1,1}),
+ ?line error = bptestx(<<>>,{1,1}),
+ ?line error = bptestx(apa,{1,1}),
+ ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ % With two variables
+ ?line 1 = bptest(<<1,2,3>>,1,1),
+ ?line 2 = bptest(<<2,1,3>>,1,1),
+ ?line error = bptest(<<1>>,1,1),
+ ?line error = bptest(<<>>,1,1),
+ ?line error = bptest(apa,1,1),
+ ?line 3 = bptest(<<2,3,3>>,1,2),
+ % Direct (autoimported) call, these will be evaluated by the compiler...
+ ?line <<2>> = binary_part(<<1,2,3>>,1,1),
+ ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ % Direct call through apply
+ ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ % Constant propagation
+ ?line Bin = <<1,2,3>>,
+ ?line ok = if
+ binary_part(Bin,1,1) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ?line ok = if
+ binary_part(Bin,{1,1}) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ok.
+bptest(B) when length(B) =:= 1337 ->
+ 1;
+bptest(B) when binary_part(B,{1,1}) =:= <<2>> ->
+ 1;
+bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> ->
+ 2;
+bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> ->
+ 3;
+bptest(_) ->
+ error.
+
+bptest(B,A) when length(B) =:= A ->
+ 1;
+bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> ->
+ 1;
+bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> ->
+ 2;
+bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> ->
+ 3;
+bptest(_,_) ->
+ error.
+
+bptestx(B,A) when length(B) =:= A ->
+ 1;
+bptestx(B,A) when binary_part(B,A) =:= <<2>> ->
+ 1;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> ->
+ 2;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> ->
+ 3;
+bptestx(_,_) ->
+ error.
+
+bptesty(B,A) when length(B) =:= A ->
+ 1;
+bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> ->
+ 1;
+bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> ->
+ 2;
+bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> ->
+ 3;
+bptesty(_,_) ->
+ error.
+
+bptest(B,A,_C) when length(B) =:= A ->
+ 1;
+bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> ->
+ 1;
+bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> ->
+ 2;
+bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
+ 3;
+bptest(_,_,_) ->
+ error.
+
+-define(FAILING(C),
+ if
+ C -> ?t:fail(should_fail);
+ true -> ok
+ end,
+ if
+ true, C -> ?t:fail(should_fail);
+ true -> ok
+ end).
+
+bad_constants(Config) when is_list(Config) ->
+ ?line ?FAILING(false),
+ ?line ?FAILING([]),
+ ?line ?FAILING([a]),
+ ?line ?FAILING([Config]),
+ ?line ?FAILING({a,b}),
+ ?line ?FAILING({a,Config}),
+ ?line ?FAILING(<<1>>),
+ ?line ?FAILING(42),
+ ?line ?FAILING(3.14),
+ ok.
+
%% Call this function to turn off constant propagation.
id(I) -> I.
@@ -1490,3 +1692,5 @@ check(F, Result) ->
io:format(" Got: ~p\n", [Other]),
test_server:fail()
end.
+
+fc({'EXIT',{function_clause,_}}) -> ok.
diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl
index 92a03ef58e..2f05eb7fca 100644
--- a/lib/debugger/test/lc_SUITE.erl
+++ b/lib/debugger/test/lc_SUITE.erl
@@ -17,21 +17,22 @@
%% %CopyrightEnd%
%%
-%%
-module(lc_SUITE).
--author('[email protected]').
+%% Copied from lc_SUITE in the compiler application.
+
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
init_per_suite/1,end_per_suite/1,
- basic/1]).
+ basic/1,deeply_nested/1,no_generator/1,
+ empty_generator/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- cases().
+ [basic, deeply_nested, no_generator, empty_generator].
groups() ->
[].
@@ -42,10 +43,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-cases() ->
- [basic].
-
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
Dog = test_server:timetrap(?t:minutes(1)),
@@ -64,7 +61,7 @@ init_per_suite(Config) when is_list(Config) ->
end_per_suite(Config) when is_list(Config) ->
ok.
-basic(Config) when list(Config) ->
+basic(Config) when is_list(Config) ->
?line L0 = lists:seq(1, 10),
?line L1 = my_map(fun(X) -> {x,X} end, L0),
?line L1 = [{x,X} || X <- L0],
@@ -73,16 +70,116 @@ basic(Config) when list(Config) ->
?line [4,5,6] = [X || X <- L0, X > 3, X < 7],
?line [] = [X || X <- L0, X > 32, X < 7],
?line [1,3,5,7,9] = [X || X <- L0, odd(X)],
+ ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)],
+ ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7],
+ ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6],
+
+ %% Append is specially handled.
+ ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++
+ [X || X <- L0, not odd(X), X =/= 6],
+
+ %% Guards BIFs are evaluated in guard context. Weird, but true.
+ ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)],
+
+ %% Filter expressions with andalso/orelse.
+ ?line "abc123" = alphanum("?abc123.;"),
%% Error cases.
- ?line [] = [X || X <- L1, X+1 < 2],
?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no],
- ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]),
+ ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]),
+ ?line [] = [X || X <- L1, X+1 < 2],
+ ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]),
+ %% A bad generator has a different exception compared to BEAM.
+ ?line {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]),
ok.
+tuple_list() ->
+ [{a,b,true},[a,b,c],glurf,{a,b,false,xx},{a,b},{x,y,true,true},{a,b,d,ddd}].
+
my_map(F, L) ->
[F(X) || X <- L].
odd(X) ->
X rem 2 == 1.
+
+alphanum(Str) ->
+ [C || C <- Str, ((C >= $0) andalso (C =< $9))
+ orelse ((C >= $a) andalso (C =< $z))
+ orelse ((C >= $A) andalso (C =< $Z))].
+
+deeply_nested(Config) when is_list(Config) ->
+ [[99,98,97,96,42,17,1764,12,11,10,9,8,7,6,5,4,3,7,2,1]] = deeply_nested_1(),
+ ok.
+
+deeply_nested_1() ->
+ %% This used to compile really, really SLOW before R11B-1...
+ [[X1,X2,X3,X4,X5,X6,X7(),X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18(),X19,X20] ||
+ X1 <- [99],X2 <- [98],X3 <- [97],X4 <- [96],X5 <- [42],X6 <- [17],
+ X7 <- [fun() -> X5*X5 end],X8 <- [12],X9 <- [11],X10 <- [10],
+ X11 <- [9],X12 <- [8],X13 <- [7],X14 <- [6],X15 <- [5],
+ X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]].
+
+no_generator(Config) when is_list(Config) ->
+ ?line Seq = lists:seq(-10, 17),
+ ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq],
+
+ %% Literal expression, for coverage.
+ ?line [a] = [a || true],
+ ?line [a,b,c] = [a || true] ++ [b,c],
+ ok.
+
+no_gen(A, B) ->
+ [{A,B} || A+B =:= 0] ++
+ [{A,B} || A*B =:= 0] ++
+ [{A,B} || A rem B =:= 3] ++
+ [{A,B} || A =:= B] ++
+ [{one_more,A,B} || no_gen_one_more(A, B)] ++
+ [A || A =:= 1] ++
+ [A || A =:= 2] ++
+ [A || A =:= 3] ++
+ [A || A =:= 4] ++
+ [A || A =:= 5] ++
+ [A || A =:= 6] ++
+ [A || A =:= 7] ++
+ [A || A =:= 8] ++
+ [A || A =:= 9] ++
+ [B || B =:= 1] ++
+ [B || B =:= 2] ++
+ [B || B =:= 3] ++
+ [B || B =:= 4] ++
+ [B || B =:= 5] ++
+ [B || B =:= 6] ++
+ [B || B =:= 7] ++
+ [B || B =:= 8] ++
+ [B || B =:= 9].
+
+no_gen_verify(Res, A, B) ->
+ Pair = {A,B},
+ ShouldBe = no_gen_eval(fun() -> A+B =:= 0 end, Pair) ++
+ no_gen_eval(fun() -> A*B =:= 0 end, Pair) ++
+ no_gen_eval(fun() -> B =/= 0 andalso A rem B =:= 3 end, Pair) ++
+ no_gen_eval(fun() -> A =:= B end, Pair) ++
+ no_gen_eval(fun() -> A + 1 =:= B end, {one_more,A,B}) ++
+ no_gen_eval(fun() -> 1 =< A andalso A =< 9 end, A) ++
+ no_gen_eval(fun() -> 1 =< B andalso B =< 9 end, B),
+ case Res of
+ ShouldBe -> ok;
+ _ ->
+ io:format("A = ~p; B = ~p; Expected = ~p, actual = ~p", [A,B,ShouldBe,Res]),
+ ?t:fail()
+ end.
+
+no_gen_eval(Fun, Res) ->
+ case Fun() of
+ true -> [Res];
+ false -> []
+ end.
+
+no_gen_one_more(A, B) -> A + 1 =:= B.
+
+empty_generator(Config) when is_list(Config) ->
+ ?line [] = [X || {X} <- [], (false or (X/0 > 3))],
+ ok.
+
+id(I) -> I.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 11:25:23 +0000