diff options
34 files changed, 4310 insertions, 6 deletions
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 19fa227912..cedb150b5d 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -13,7 +13,11 @@ ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) INSTALL_PROGS= $(TARGET_FILES) -EMAKEFILE=Emakefile +# ---------------------------------------------------- +# Files +# ---------------------------------------------------- +EMAKEFILE = Emakefile +AUXILIARY_FILES = hipe.spec hipe_testsuite_driver.erl $(EMAKEFILE) # ---------------------------------------------------- # Release directory specification @@ -56,10 +60,14 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt +release_docs_spec: + release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) hipe.spec "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" - -release_docs_spec: + $(INSTALL_DATA) $(AUXILIARY_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + cd "$(RELSYSDIR)";\ + erlc hipe_testsuite_driver.erl;\ + erl -noshell -run hipe_testsuite_driver create_all_suites -s erlang halt diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl new file mode 100644 index 0000000000..af5a3b2f23 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -0,0 +1,18 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +%% The guard in f/3 revealed a problem in the translation of the 'bs_add' +%% BEAM instruction to Icode. The fail label was not properly translated. +%% Fixed 3/2/2011. +%%------------------------------------------------------------------------- +-module(bs_add). + +-export([test/0]). + +test() -> + 42 = f(<<12345:16>>, 4711, <<42>>), + ok. + +f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> + gazonk; +f(Bin, _, _) when is_binary(Bin) -> + 42. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl new file mode 100644 index 0000000000..082b83bab9 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl @@ -0,0 +1,79 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bincomp.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Test bit comprehensions +%%% Created : 13 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bincomp). + +-export([test/0]). + +test() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>, + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<"ABCDEFG">> >>, + <<"ABCDEFG">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>, + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, + "abcdefg" = [(X+32) || <<X>> <= <<"ABCDEFG">>], + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>], + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- "ABCDEFG" >>, + "ABCDEFG" = [(X-32) || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>], + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]], + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bits.erl b/lib/hipe/test/bs_SUITE_data/bs_bits.erl new file mode 100644 index 0000000000..ef9a6bb137 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bits.erl @@ -0,0 +1,150 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bits.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests for bit stream operations including matching, +%%% construction, binary_to_list and list_to_binary +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bits). + +-export([test/0]). + +test() -> + <<1:100>> = <<1:100>>, + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_is_bitstr(<<1:1>>,<<8>>), + ok = test_is_binary(<<1:1>>,<<8>>), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = bitstr_to_and_from_list(), + ok = big_bitstr_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +match(N) -> + <<0:N>> = <<0:N>>, + ok. + +match1(N) -> + <<42:N/little>> = <<42:N/little>>, + ok. + +test_is_bitstr(Bitstr, Binary) -> + true = is_bitstring(Bitstr), + true = is_bitstring(Binary), + ok = if is_bitstring(Bitstr) -> ok end, + ok = if is_bitstring(Binary) -> ok end. + +test_is_binary(Bitstr, Binary) -> + false = is_binary(Bitstr), + true = is_binary(Binary), + ok = if is_binary(Bitstr) -> not_ok; true -> ok end, + ok = if is_binary(Binary) -> ok end. + +test_bitsize() -> + 101 = erlang:bit_size(<<1:101>>), + 1001 = erlang:bit_size(<<1:1001>>), + 80 = erlang:bit_size(<<1:80>>), + 800 = erlang:bit_size(<<1:800>>), + Bin = <<0:16#1000000>>, + BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + 16#10000001 = bit_size(BigBin), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = bit_size(HugeBin), + 0 = erlang:bit_size(<<>>), + ok. + +horrid_match() -> + <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + <<42:24/little>> = B, + ok. + +test_bitstr() -> + <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + <<1:1,6>> = B, + B = <<1:1,6>>, + ok. + +asymmetric_tests() -> + <<1:12>> = <<0,1:4>>, + <<0,1:4>> = <<1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X, + X = <<1,254,0,0:1>>, + <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X1, + X1 = <<1,254,0,0:1>>, + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = <<1:875,0,1:4>>, + <<1:875,0,1:4>> = <<1:875,1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X, + X = <<1,254,0,0:1,1:875>>, + <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X1, + X1 = <<1,254,0,0:1,1:875>>, + ok. + +bitstr_to_and_from_list() -> + <<1:7>> = list_to_bitstring(bitstring_to_list(<<1:7>>)), + <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + ok. + +big_bitstr_to_and_from_list() -> + <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + ok. + +send_and_receive() -> + Bin = <<1,2:7>>, + Pid = spawn(fun() -> receiver(Bin) end), + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end. + +receiver(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + Bin = <<1:1000001>>, + Pid = spawn(fun() -> receiver_alot(Bin) end), + send_alot(100,Bin,Pid). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl new file mode 100644 index 0000000000..c0774e7279 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +-module(bs_bitsize). + +-export([test/0]). + +test() -> + true = bitsize_in_body(<<1:42>>), + true = bitsize_in_guard(<<1:7>>), + 8 = constant_binary(42), + ok. + +bitsize_in_body(Bin) -> + 42 =:= erlang:bit_size(Bin). + +bitsize_in_guard(Bin) when erlang:bit_size(Bin) rem 7 =:= 0 -> + true; +bitsize_in_guard(Bin) when is_bitstring(Bin) -> + false. + +%% Tests that binary constants can properly be treated in Icode +constant_binary(N) when N > 0 -> + bit_size(<<42>>). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl new file mode 100644 index 0000000000..7b62a17cfb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl @@ -0,0 +1,32 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% When executing this in R8 (and compiled with R8) the result was +%% {ok,[148,129,0,0]} but should be {ok,[145,148,113,129,0,0,0,0]} +%% Thanks to Kenneth Lundin for sending this to us. +%%------------------------------------------------------------------- + +-module(bs_bugs_R08). + +-export([test/0]). + +test() -> + List = [145,148,113,129,0,0,0,0], + {ok, List} = msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []), + ok. + +%% msisdn_internal_storage/3 +%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +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 diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl new file mode 100644 index 0000000000..670f2a08bb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Date: Mon, 7 Jun 2004 13:07:39 +0300 +%% From: Einar Karttunen +%% To: Erlang ML <[email protected]> +%% Subject: Apparent binary matching bug with native compilation +%% +%% It seems that there is a problem with binary matching when +%% compiling native code. A length prefixed field matches one +%% byte too short in the native case. +%% +%% The test module works when compiled with no options, but +%% crashes with case_clause when compiled with [native]. +%% This has been confirmed with R9C-0 and hipe snapshot 5/4/2004. +%%-------------------------------------------------------------------- + +-module(bs_bugs_R09). + +-export([test/0]). + +test() -> + ["rei",".",[]] = pp(<<3,$r,$e,$i,0>>), + ok. + +pp(Bin) -> + %% io:format("PP with ~p~n", [Bin]), + case Bin of + <<>> -> + ["."]; + <<_:2, Len:6, Part:Len/binary>> -> + [binary_to_list(Part)]; + <<_:2, Len:6, Part:Len/binary, Rest/binary>> -> + %% io:format("Len ~p Part ~p Rest ~p~n", [Len,Part,Rest]), + [binary_to_list(Part), "." | pp(Rest)] + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl new file mode 100644 index 0000000000..43ee9eb85b --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl @@ -0,0 +1,133 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Contains three cases of bugs that were reported for R12B +%%-------------------------------------------------------------------- +-module(bs_bugs_R12). + +-export([test/0]). + +test() -> + ok = test_beam_bug(), + ok = test_v3_codegen(), + ok = test_hipe_bug(), + ok. + +%%-------------------------------- +%% First test case: a bug in BEAM +%%-------------------------------- +test_beam_bug() -> + lists:foreach(fun (_) -> ok = run(100) end, [1,2,3,4]). + +%% For testing - runs scanner N number of times with same input +run(N) -> + lists:foreach(fun(_) -> scan(<<"region:whatever">>, []) end, lists:seq(1, N)). + +scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); +scan(<<D, Z, Rest/binary>>, TokAcc) + when (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); +scan(<<D>>, TokAcc) when (D =:= $D) or (D =:= $d) -> + scan(<<>>, ['AND' | TokAcc]); +scan(<<N, Z, Rest/binary>>, TokAcc) + when (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); +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>> -> + scan(R, [{'FIELD', C} | TokAcc]); + _ -> + scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + +%%--------------------------------------------------- +%% Second test case: an internal error in v3_codegen +%% Reported by Mateusz Berezecki on 19/1/2008 +%%--------------------------------------------------- +-define(S, {42, 4242, 4711}). +-define(R, <<90,164,116>>). + +test_v3_codegen() -> + _ = random:seed(?S), + B0 = gen_bit(120, <<>>), + B1 = set_bit(B0, 5), + B2 = clr_bit(B1, 5), + ?R = set_bit(B2, 5), + ok. + +gen_bit(0, Acc) -> Acc; +gen_bit(N, Acc) when is_integer(N), N > 0 -> + gen_bit(N-1, <<Acc/bits, (random:uniform(2)-1):1>>). + +%% sets bit K in the Bitmap +set_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 1:1, AfterBits/bits>>. + +%% clears bit K in the Bitmap +clr_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 0:1, AfterBits/bits>>. + +%%-------------------------------------------------------------------- +%% Third test case: a bug in HiPE +%% Reported by Steve Vinoski on 1/3/2008 +%% +%% Below find the results of compiling and running the example code at +%% the bottom of this message. Using "c" to compile gives the right +%% answer; using "hipe:c" gives the wrong answer. This is with R12B-1. +%% +%% Within the code, on the second instance of function check/2 you'll +%% find a commented-out guard. If you uncomment the guard, then the +%% code works correctly with both "c" and "hipe:c". +%%--------------------------------------------------------------------- + +test_hipe_bug() -> + String = "2006/10/02/Linux-Journal", + Binary = list_to_binary(String), + StringToMatch = "200x/" ++ String ++ " ", + BinaryToMatch = list_to_binary(StringToMatch), + {ok, Binary} = match(BinaryToMatch), + ok. + +match(<<>>) -> + nomatch; +match(Bin) -> + <<Front:16/binary, Tail/binary>> = Bin, + case Front of + <<_:3/binary,"x/",Y:4/binary,$/,M:2/binary,$/,D:2/binary,$/>> -> + case check(Tail) of + {ok, Match} -> + {ok, <<Y/binary,$/,M/binary,$/,D/binary,$/,Match/binary>>}; + {nomatch, Skip} -> + {skip, Skip+size(Front)}; + _ -> + wrong_answer + end; + _ -> + nomatch + end. + +check(Bin) -> + check(Bin, 0). +check(<<$ , _/binary>>, 0) -> + {nomatch, 0}; +check(Bin, Len) -> %when Len < size(Bin) -> + case Bin of + <<Front:Len/binary, $ , _/binary>> -> + {ok, Front}; + <<_:Len/binary, $., _/binary>> -> + {nomatch, Len}; + _ -> + check(Bin, Len+1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_build.erl b/lib/hipe/test/bs_SUITE_data/bs_build.erl new file mode 100644 index 0000000000..256cea9403 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_build.erl @@ -0,0 +1,41 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_build.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 12 Sep 2007 +%%%------------------------------------------------------------------- +-module(bs_build). + +-export([test/0]). + +test() -> + <<0,1,2,3,4,5,6>> = Bin = << <<X>> || X <- lists:seq(0, 6)>>, + test(Bin). + +test(Bin) -> + <<0,1,2,3,4,5,6,0,1,2,3,4,5,6>> = RealBin = multiply(Bin, 2), + <<6,5,4,3,2,1,0,6,5,4,3,2,1,0>> = reverse(RealBin), + RealBin = copy(RealBin), + RealBin = bc(RealBin), + ok. + +multiply(Bin, 1) -> + Bin; +multiply(Bin, N) when N > 0 -> + <<(multiply(Bin, N-1))/binary, Bin/binary>>. + +bc(Bin) -> + << <<X>> || <<X>> <= Bin >>. + +reverse(<<X, Rest/binary>>) -> + <<(reverse(Rest))/binary, X>>; +reverse(<<>>) -> <<>>. + +copy(Bin) -> + copy(Bin, <<>>). + +copy(<<X, Rest/binary>>, Bin) -> + copy(Rest, <<Bin/binary, X>>); +copy(<<>>, Bin) -> Bin. diff --git a/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl new file mode 100644 index 0000000000..6125f8f87f --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl @@ -0,0 +1,25 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_catch_bug.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests a catch-related bug which might destroy properties +%%% of ICode CFGs which are assumed by the subsequent ICode +%%% binary pass. +%%% Created : 22 Jan 2004 +%%% ------------------------------------------------------------------- +-module(bs_catch_bug). + +-export([test/0]). + +test() -> + test(foo, <<>>). + +%% Introduced auxiliary test/2 function so that constant propagation +%% does not destroy the properties of the test. - Kostis 26/1/2004 +test(X, Bin) -> + catch (<<_/binary>> = X), + X = case Bin of + <<42,_/binary>> -> weird_bs_match; + _ -> X + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_checksum.erl b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl new file mode 100644 index 0000000000..ca4f254f12 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Code from Zoltan Toth that crashed the HiPE compiler (in R11B-3). +%% The problem was that the binary matching produces a pretty large +%% integer and we tried to find the range for this integer in a bad way. +%% Fixed on the same day -- 6th March 2007. +%%-------------------------------------------------------------------- + +-module(bs_checksum). + +-export([test/0]). + +test() -> + "3389DAE361AF79B04C9C8E7057F60CC6" = checksum(<<42>>), + ok. + +checksum(Bin) -> + Context = erlang:md5_init(), + checksum(Context, Bin). + +checksum(Context, <<>>) -> + bin_to_hex(erlang:md5_final(Context)); +checksum(Context, <<Bin:20480/binary,Rest/binary>>) -> + checksum(erlang:md5_update(Context, Bin), Rest); +checksum(Context,Bin) -> + checksum(erlang:md5_update(Context, Bin), <<>>). + +bin_to_hex(Bin) -> + lists:flatten([byte_to_hex(X) || X <- binary_to_list(Bin)]). + +byte_to_hex(Byte) -> + [int_to_hex(Byte div 16), int_to_hex(Byte rem 16)]. + +int_to_hex(Int) when Int < 10 -> $0 + Int; +int_to_hex(Int) when Int > 9 -> $A + Int - 10. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl new file mode 100644 index 0000000000..9cc9ac848c --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -0,0 +1,128 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary construction work +%%-------------------------------------------------------------------- +-module(bs_construct). + +-export([test/0]). + +test() -> + <<42>> = sz(8), + <<42:8/little>> = sz_little(8), + <<55>> = take_five(1, 3, 1, 7, 4), + ok = bs5(), + 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), + ok = bad_ones(), + ok. + +%%-------------------------------------------------------------------- +%% Taken from a bug report submitted by Dan Wallin (24 Oct 2003), the +%% following cases test construction of binaries whose segments have +%% sizes that are statically unknown. + +sz(S) -> + <<42:S>>. + +sz_little(S) -> + <<42:S/little>>. + +take_five(A, Head, FB, C, Tail) -> + <<A:Head, FB:1, C:Tail>>. + +%%-------------------------------------------------------------------- + +bs5() -> + Const = mk_constant(), + Pairs = mk_pairs(), + true = are_same(Const, Pairs), + true = lists:all(fun ({B, L}) -> binary_to_list(B) =:= L end, Pairs), + ok. + +are_same(C, L) -> + C =:= L. + +mk_constant() -> + [{<<213>>,[213]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<71>>,[71]}, + {<<8,1>>,[8,1]}, + {<<3,9>>,[3,9]}, + {<<9,3>>,[9,3]}, + {<<0,0,0,0>>,[0,0,0,0]}, + {<<62,0,0,0>>,[62,0,0,0]}, + {<<0,0,0,62>>,[0,0,0,62]}, + {<<138,99,0,147>>,[138,99,0,147]}, + {<<138,99,0,148>>,[138,99,0,148]}, + {<<147,0,99,138>>,[147,0,99,138]}, + {<<255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255>>, + [255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]}, + {<<13>>,[13]}, + {<<0,4,0,5>>,[0,4,0,5]}, + {<<129>>,[129]}, + {<<129>>,[129]}, + {<<1,2>>,[1,2]}, + {<<1>>,[1]}, + {<<4,3,1>>,[4,3,1]}, + {<<47>>,[47]}, + {<<>>,[]}, + {<<97,112,97>>,[97,112,97]}, + {<<46,110,142,77,45,204,233>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +mk_pairs() -> + L4 = [138,99,0,147], + [{<<-43>>,[256-43]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<4:4,7:4>>,[4*16+7]}, + {<<1:5,1:11>>,[1*8,1]}, + {<<777:16/big>>,[3,9]}, + {<<777:16/little>>,[9,3]}, + {<<0.0:32/float>>,[0,0,0,0]}, + {<<0.125:32/float>>,[62,0,0,0]}, + {<<0.125:32/little-float>>,[0,0,0,62]}, + {<<57285702734876389752897683:32>>,L4}, + {<<57285702734876389752897684:32>>,[138,99,0,148]}, + {<<57285702734876389752897683:32/little>>,lists:reverse(L4)}, + {<<-1:17/unit:8>>,lists:duplicate(17,255)}, + {<<13>>,[13]}, + {<<4:8/unit:2,5:2/unit:8>>,[0,4,0,5]}, + {<<1:1,0:6,1:1>>,[129]}, + {<<1:1/little,0:6/little,1:1/little>>,[129]}, + {<<<<1,2>>/binary>>,[1,2]}, + {<<<<1,2>>:1/binary>>,[1]}, + {<<4,3,<<1,2>>:1/binary>>,[4,3,1]}, + {<<(256*45+47)>>,[47]}, + {<<57:0>>,[]}, + {<<"apa">>,"apa"}, + {<<1:3,"string",9:5>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +%%-------------------------------------------------------------------- +%% Constructs a big enough binary to have a bit size that needs a +%% bignum on 32-bit architectures + +large_bin(X1, X2, X3, X4) -> + Sz = 16#4000000, + <<1, <<X1:Sz, X2:Sz, X3:Sz, X4:Sz>>/bits>>. + +%%-------------------------------------------------------------------- +%% Test construction of "bad" binaries + +-define(FAIL(Expr), {'EXIT', {badarg, _}} = (catch Expr)). + +bad_ones() -> + PI = math:pi(), + ?FAIL(<<PI>>), + Bin12 = <<1,2>>, + ?FAIL(<<Bin12>>), + E = 2.71, + ?FAIL(<<E/binary>>), + Int = 24334, + ?FAIL(<<Int/binary>>), + BigInt = 24334344294788947129487129487219847, + ?FAIL(<<BigInt/binary>>), + Bin123 = <<1,2,3>>, + ?FAIL(<<Bin123/float>>), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode.erl b/lib/hipe/test/bs_SUITE_data/bs_decode.erl new file mode 100644 index 0000000000..d12654a1e3 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode.erl @@ -0,0 +1,980 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(bs_decode). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok,{sesT_createReqV0, + {mvsgT_tid,{mvsgT_imsi,<<81,67,101,7,0,0,0,240>>},6}, + [81,67,101,7,0,0,0,96], + {sesT_qualityOfServiceV0,1,4,9,2,18}, + 0,subscribed,0,0, + {mvsgT_pdpAddressType,ietf_ipv4,[]}, + [<<"apn013a">>,<<"ericsson">>,<<"se">>], + {masT_protocolConfigOptions,[], + {masT_pap,true,1,5,"user5","pass5"}, + []}, + {mvsgT_ipAddress,ipv4,172,28,12,1,0,0,0,0}, + {mvsgT_ipAddress,ipv4,172,28,12,3,0,0,0,0}, + {mvsT_msisdn,<<145,148,113,129,0,0,0,0>>}}, + 1}). + +test() -> + ?RES = decode_v0_opt(42, ?PDU), + ok. + +decode_v0_opt(0, Pdu) -> + decode_gtpc_msg(Pdu); +decode_v0_opt(N, Pdu) -> + decode_gtpc_msg(Pdu), + decode_v0_opt(N-1, Pdu). + +%%% -------------------------------------------------------------- +%%% #3.1.2 DECODE GTP-C MESSAGE +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% Function : decode_gtpc_msg(GTP_C_Message)-> +%%% {ok,Request,ControlDataUs} | +%%% {fault,Cause,Request,ControlDataUs} +%%% +%%% Types : GTP_C_Message = binary(), GTP-C message from SGSN +%%% Request = record(), Containing decoded request +%%% ControlDataUS = record(), Containing header info +%%% Cause = integer(), Error code +%%% +%%% Description: This function decodes a binary GTP-C message and +%%% stores it in a record. Different records are used +%%% for different message types. +%%% +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +%%% Create PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,16:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + Errors = #protocolErrors{}, + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyCreateReq = #sesT_createReqV0{tid = TID2, + tidRaw = binary_to_list(TID)}, + case catch decode_ie_create(InformationElements,0,Errors,EmptyCreateReq) of + {ok,CreateReq} -> + {ok,CreateReq,SequenceNumber}; + {fault,Cause,CreateReq} -> + {fault,Cause,CreateReq,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyCreateReq,SequenceNumber} + end; + +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,18:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + io:format("hej", []), + Errors = #protocolErrors{}, + {ok,TID2}=tid_internal_storage(TID,[]), + EmptyUpdateReq=#sesT_updateReqV0{tid=TID2, + tidRaw=binary_to_list(TID)}, + case catch decode_ie_update(InformationElements,0,Errors, + EmptyUpdateReq) of + {ok,UpdateReq} -> + {ok,UpdateReq,SequenceNumber}; + {fault,Cause,UpdateReq} -> + {fault,Cause,UpdateReq,SequenceNumber}; + {'EXIT',Reason} -> + io:format("hej", []), + {fault,193,EmptyUpdateReq,SequenceNumber, Reason} + end; + +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,20:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + DeleteReq = #sesT_deleteReqV0{tid=TID2}, + {ok,DeleteReq,SequenceNumber}; + +%%% Delete PDP Context Response +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,21:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyDeleteRes = #sesT_deleteResV0{tid=TID2}, + case catch decode_ie_delete_res(InformationElements,0,EmptyDeleteRes) of + {ok, DeleteRes} -> + {ok,DeleteRes,SequenceNumber}; + {fault,Cause,DeleteRes} -> + {fault,Cause,DeleteRes,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyDeleteRes,SequenceNumber} + end; + +%%% Error handling +decode_gtpc_msg(_GTP_C_Message) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_create/4 +%%% Decode information elements for Create PDP Context Request + +%%% All elements decoded +decode_ie_create(<<>>,PresentIEs,Errors,CreateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#77D) =/= 16#77D -> + {fault,202,CreateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,CreateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,CreateReq}; %Invalid message format + #protocolErrors{incorrectOptIE=true} -> %Incorrect optional IE + {fault,203,CreateReq}; %Optional IE incorrect + _ -> %OK + {ok,CreateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_create(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedCreateReq) + end; + +%%% Recovery, Optional +decode_ie_create(<<14:8,Recovery:8,Rest/binary>>, + PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedCreateReq) + end; + +%%% Selection mode, Mandatory +decode_ie_create(<<15:8,_:6,SelectionMode:2,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_create(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_create(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000010) =:= 16#00000010 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000010 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010),Errors, + UpdatedCreateReq) + end; + +%%% End User Address, Mandatory +decode_ie_create(<<128:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<PDPElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000020) =:= 16#00000020 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000020 -> %Out of sequence + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end; + true -> %OK + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end + end; + +%%% Access Point Name, Mandatory +decode_ie_create(<<131:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<APNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000040) =:= 16#00000040 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000040 -> %Out of sequence + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end + end; + +%%% Protocol Configuration Options, Optional +decode_ie_create(<<132:8,Length:16,More/binary>>,PresentIEs,Errors,CreateReq) -> + <<ConfigurationElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000080) =:= 16#00000080 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000080 -> %Out of sequence + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_create(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000300) =:= 16#00000300 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000200 -> %Out of sequence + if + (PresentIEs band 16#00000100) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + PresentIEs < 16#00000100 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + +%%% MSISDN, Mandatory +decode_ie_create(<<134:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<MSISDNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000400) =:= 16#00000400 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000400 -> %Out of sequence + case msisdn_internal_storage(MSISDNElement,[]) of + {ok,MSISDN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=MSISDN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true,invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,CreateReq) + end; + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=#mvsT_msisdn{value=MSISDNElement}}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + Errors,UpdatedCreateReq) + + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_create(UnexpectedIE,PresentIEs,Errors,CreateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,CreateReq} %Invalid message format + end. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_update/4 +%%% Decode information elements for Update PDP Context Request + +%%% All elements decoded +decode_ie_update(<<>>,PresentIEs,Errors,UpdateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#3D) =/= 16#3D -> + {fault,202,UpdateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,UpdateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,UpdateReq}; %Invalid message format + _ -> %OK + {ok,UpdateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_update(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,UpdateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedUpdateReq) + end; + +%%% Recovery, Optional +decode_ie_update(<<14:8,Recovery:8,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_update(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_update(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedUpdateReq) + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_update(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,UpdateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000030) =:= 16#00000030 -> %Repeated IE, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000020 -> %Out of sequence + if + (PresentIEs band 16#00000010) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + PresentIEs < 16#00000010 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_update(UnexpectedIE,PresentIEs,Errors,UpdateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,UpdateReq} %Invalid message format + end. + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_req/4 +%%% Decode information elements for Delete PDP Context Request + +%%% Private Extension, Optional +%%% Not implemented + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_res/4 +%%% Decode information elements for Delete PDP Context Response + +%%% All elements decoded +decode_ie_delete_res(<<>>,PresentIEs,DeleteRes) -> + %% Check mandatory IE's + if + (PresentIEs band 16#0001) =/= 16#0001 -> + {fault,202,DeleteRes}; %Mandatory IE missing + true -> %OK + {ok,DeleteRes} + end; + +%%% Cause, Mandatory +decode_ie_delete_res(<<1:8,Cause:8,Rest/binary>>,PresentIEs,DeleteRes) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + true -> %OK + UpdatedDeleteRes=DeleteRes#sesT_deleteResV0{cause=Cause}, + decode_ie_delete_res(Rest,(PresentIEs bor 16#00000001), + UpdatedDeleteRes) + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_delete_res(UnexpectedIE,PresentIEs,DeleteRes) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {handled_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {unhandled_ie} -> %Error, abort decoding + {fault,193,DeleteRes} %Invalid message format + end. + +%%% -------------------------------------------------------------- +%%% #3.2 COMMON INTERNAL FUNCTIONS +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% check_ie/1 +%%% Check Information Element, Unexpected or Unknown +check_ie(<<1:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% IMSI +check_ie(<<2:8,_:8/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% RAI +check_ie(<<3:8,_:6/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TTLI +check_ie(<<4:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI +check_ie(<<5:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Quality of Service Profile +check_ie(<<6:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Reordering Required +check_ie(<<8:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Authentication Triplet +check_ie(<<9:8,_:28/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MAP Cause +check_ie(<<11:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI Signature +check_ie(<<12:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Validated +check_ie(<<13:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Recovery +check_ie(<<14:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Selection Mode +check_ie(<<15:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data I +check_ie(<<16:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Signalling +check_ie(<<17:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data II +check_ie(<<18:8,_:32,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Not Reachable Reason +check_ie(<<19:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Charging ID +check_ie(<<127:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TLV element, skipped using Length +check_ie(<<1:1,_:7,Length:16,More/binary>>) -> + if + Length > byte_size(More) -> + {unhandled_ie}; + true -> + <<_:Length/binary-unit:8,Rest/binary>> = More, + {handled_ie,Rest} + end; +%%% TV element, unknown size. Can not be handled. +check_ie(_UnhandledIE) -> + {unhandled_ie}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value = Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. +%% tid_internal_storage(<<NSAPI:4,2#1111:4>>,IMSI) -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse(IMSI)}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<NSAPI:4,DigitN:4>>,IMSI) when +%% DigitN < 10 -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse([(DigitN bor 2#11110000)|IMSI])}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<2#11111111:8,Rest/binary>>,IMSI) -> +%% tid_internal_storage(Rest,IMSI); +%% tid_internal_storage(<<2#1111:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[(DigitN bor 2#11110000)|IMSI]); +%% tid_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitNplus1 < 10, +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[((DigitNplus1 bsl 4) bor DigitN)|IMSI]); +%% tid_internal_storage(_Rest,_IMSI) -> +%% {fault}. %% Mandatory IE incorrect + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% selection_mode_internal_storage/1 +%%% Convert Selection Mode integer to internal datatype (enum) +selection_mode_internal_storage(0) -> + subscribed; +selection_mode_internal_storage(1) -> + msRequested; +selection_mode_internal_storage(2) -> + sgsnSelected; +selection_mode_internal_storage(3) -> + sgsnSelected. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pdp_addr_internal_storage/1 +%%% Convert PDP address to internal datatype (record containing +%%% addresstype and value) +pdp_addr_internal_storage(<<_:4,0:4,1:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_ppp,address=[]}}; +pdp_addr_internal_storage(<<_:4,0:4,2:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_osp_ihoss,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8,IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4, + address=[IP_A,IP_B,IP_C,IP_D]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#57:8,IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv6, + address=[IP_A,IP_B,IP_C,IP_D,IP_E,IP_F,IP_G,IP_H]}}; +pdp_addr_internal_storage(_PDP_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% apn_internal_storage/2 +%%% Convert APN to internal datatype (List containing APN labels) +apn_internal_storage(<<>>,APN) -> + {ok,lists:reverse(APN)}; +apn_internal_storage(<<Length:8,Rest/binary>>,APN) -> + <<Label:Length/binary-unit:8,MoreAPNLabels/binary>> = Rest, + apn_internal_storage(MoreAPNLabels,[Label|APN]). + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pco_internal_storage/1 +%%% Convert Protocol Configuration Options to internal datatype. +%%% Implemented configuration options: +%%% For PPP: +%%% LCP - Not implemented +%%% PAP - Authenticate request +%%% CHAP - Challenge +%%% - Response +%%% IPCP - IP-Address +%%% For OSP:IHOSS +%%% Nothing implemented +pco_internal_storage(<<1:1,_:4,0:3,PPPConfigurationOptions/binary>>) -> + case ppp_configuration_options(PPPConfigurationOptions, + #masT_pap{exists=false},[],[]) of + {ok,PAP,CHAP,IPCP} -> + {ok,#masT_protocolConfigOptions{pap=PAP,chap=CHAP,ipcp=IPCP}}; + {fault} -> + {fault} + end; +pco_internal_storage(<<1:1,_:4,1:3,_OSP_IHOSSConfigurationOptions/binary>>) -> + {ok,osp_ihoss}; +pco_internal_storage(_UnknownConfigurationOptions) -> + {fault}. %% Optional IE incorrect + +ppp_configuration_options(<<>>,PAP,CHAP,IPCP) -> + {ok,PAP,CHAP,IPCP}; +ppp_configuration_options(<<16#C021:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% LCP - Not implemented + <<_LCP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C023:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,_PAP,CHAP,IPCP) -> + %% PAP - Authenticate request + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<PeerIDLength:8,PeerData/binary>> = Data, + <<PeerID:PeerIDLength/binary-unit:8,PasswdLength:8,PasswordData/binary>> = PeerData, + <<Password:PasswdLength/binary,_Padding/binary>> = PasswordData, + ppp_configuration_options(Rest,#masT_pap{exists=true,code=1,id=Identifier, + username=binary_to_list(PeerID), + password=binary_to_list(Password)},CHAP,IPCP); + +ppp_configuration_options(<<16#C023:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% PAP - Other, not implemented + <<_PAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Challenge + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=1,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,2:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Response + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=2,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Other, not implemented + <<_CHAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#8021:16,_Length:8,1:8,Identifier:8,OptionsLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% IPCP - Configure request + ActualOptionsLength=OptionsLength-4, %% OptionsLength includes Code, Identifier and itself + <<Options:ActualOptionsLength/binary-unit:8,Rest/binary>> = More, + case Options of + <<3:8,6:8,A1:8,A2:8,A3:8,A4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=3,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=A1,a2=A2, + a3=A3,a4=A4, + a5=0,a6=0, + a7=0,a8=0}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + <<129:8,6:8,B1:8,B2:8,B3:8,B4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=129,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=B1,a2=B2, + a3=B3,a4=B4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + + <<131:8,6:8,C1:8,C2:8,C3:8,C4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=131,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=C1,a2=C2, + a3=C3,a4=C4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + _ -> + ppp_configuration_options(Rest,PAP,CHAP,IPCP) + end; +ppp_configuration_options(<<_UnknownProtocolID:16,Length:8,More/binary>>, + PAP,CHAP,IPCP) -> + <<_Skipped:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(_Unhandled,_PAP,_CHAP,_IPCP) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% gsn_addr_internal_storage/1 +%%% Convert GSN Address to internal datatype +gsn_addr_internal_storage(<<IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_ipAddress{version=ipv4,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D,a5=0,a6=0,a7=0,a8=0}}; +gsn_addr_internal_storage(<<IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_ipAddress{version=ipv6,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D, + a5=IP_E,a6=IP_F,a7=IP_G,a8=IP_H}}; +gsn_addr_internal_storage(_GSN_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% msisdn_internal_storage/3 +%%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,#mvsT_msisdn{value=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 diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl new file mode 100644 index 0000000000..80add514a0 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl @@ -0,0 +1,91 @@ +-ifndef(EXTDEC_HRL). +-define(EXTDEC_HRL, true). + +-record(protocolErrors,{ + invalidManIE=false, + outOfSequence=false, + incorrectOptIE=false}). +-record(mvsT_msisdn, {value}). +-record(mvsT_isdnAddress, {value}). +-record(mvsT_hlrAddress, {value}). +-record(mvsT_authenticationTriplet, {rand, sres, kc}). +-record(mvsT_authenticationQuintuplet, {rand, xres, ck, ik, autn}). +-record(mvsT_resynchInfo, {rand, auts}). +-record(mvsT_resynch, {label, value}). +-record(mvsT_storeImsiFault, {label, value}). +-record(mvsT_additionalImsisResults, {roamingStatus, defaultApnOperatorId, misc1, misc2, misc3}). +-record(mvsT_pdpActiveRecord, {contextId, nsapi, pdpTypeReq, pdpAddrReq, apnReq, qosReq, pdpTypeInUse, pdpAddressNature, pdpAddressInUse, apnInUse, ggsnAddrInUse, qosNegotiated}). +-record(mvsgT_rai, {mcc, mnc, lac, rac}). +-record(mvsgT_lai, {mcc, mnc, lac}). +-record(mvsgT_errorInd, {dummyElement}). +-record(mvsgT_deleteRes, {cause}). +-record(mvsgT_deleteReq, {dummyElement}). +-record(mvsgT_ptmsi, {value}). +-record(mvsgT_ddRef, {cid, extId, validity}). +-record(mvsgT_dpRef, {cid, devId}). +-record(mvsgT_qualityOfService, {delayClass, relClass, peakThrput, precClass, meanThrput}). +-record(mvsgT_pdpAddressType, {pdpTypeNbr, address}). +-record(mvsgT_msNetworkCapability, {gea1, smCapDediccatedChannel, smCapGprsChannel, ucs2Support, ssScreenInd}). +-record(mvsgT_cellId, {mcc, mnc, lac, rac, ci}). +-record(mvsgT_ipAddress, {version, a1, a2, a3, a4, a5, a6, a7, a8}). +-record(mvsgT_restartContextData, {gsn_address, restart_counter}). +-record(mvsgT_updateRes, {cause, qos, ggsnAddSig, ggsnAddUser, recovery, flowLabDataI, flowLabSig, chargId, optFlags}). +-record(mvsgT_updateReq, {qos, sgsnAddSig, sgsnAddUser, recovery, flowLabDataI, flowLabSig, otpFlags}). +-record(mvsgT_imsi, {value}). +-record(mvsgT_tid, {imsi, nsapi}). +-record(mvsgT_extQualityOfService, {allocRetention, trfClass, delOrder, delOfErrSDU, maxSDUSize, maxBRUp, maxBRDown, residualBER, sduErrorRatio, transferDelay, traffHandlPrio, guarBRUp, guarBRDown}). +-record(mvsgT_qualServ, {label, value}). +-record(sesT_gnDevContextData, {numberOfContext, recoveryInfoArray}). +-record(sesT_tid, {imsi, nsapi}). +-record(sesT_gnDevContextDataInfo, {dummy}). +-record(sesT_teid, {value}). +-record(sesT_qualityOfServiceV1, {allocRetPriority, delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput, trafficClass, deliveryOrder, delivOfErrSDU, maxSDUsize, maxBrUp, maxBrDown, residualBER, sduErrorRatio, transferDelay, trafficHandlPrio, guaranteedBrUp, guaranteedBrDown}). +-record(sesT_flowLbl, {value}). +-record(sesT_qualityOfServiceV0, {delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput}). +-record(sesT_createReq, {dummy}). +-record(sesT_createRes, {dummy}). +-record(sesT_deleteReq, {dummy}). +-record(sesT_deleteRes, {dummy}). +-record(sesT_gtid, {imsi, nsapi}). +-record(sesT_updateReq, {dummy}). +-record(sesT_updateRes, {dummy}). +-record(sesT_gcontrolDataUs, {gtpSeqNr, gsnAddress, gtunnelId, gsnPort}). +-record(sesT_gcontrolDataDs, {gtpSeqNr, gsnAddress, protocol, gtunnelId, flowLabSig, gsnPort}). +-record(sesT_createResV1, {cause, teidSignalling, teidData, ggsnAddSig, ggsnAddUser, reorderingReq, recovery, chargId, endUserAdd, optFlags, protConOpt, qos}). +-record(sesT_createReqV1, {qos, sgsnAddSig, sgsnAddUser, selMode, recovery, msisdn, endUserAdd, accPointName, optFlags, protConOpt, imsi, teidData, teidSignalling, nsapi}). +-record(sesT_deleteReqV1, {teardownInd, nsapi}). +-record(sesT_deleteResV1, {cause}). +-record(sesT_updateReqV1, {imsi, recovery, teidData, teidSignalling, nsapi, sgsnAddSig, sgsnAddUser, qos}). +-record(sesT_updateResV1, {cause, recovery, teidData, teidSignalling, chargId, ggsnAddSig, ggsnAddUser, qos}). +-record(sesT_deleteReqV0, {tid}). +-record(sesT_deleteResV0, {tid, cause}). +-record(sesT_createReqV0, {tid, tidRaw, qos, recovery, selMode, flowLblData, flowLblSig, endUserAdd, accPointName, protConOpt, sgsnAddSig, sgsnAddUser, msisdn}). +-record(sesT_createResV0, {tid, cause, qos, reorderingReq, recovery, flowLblData, flowLblSig, chargId, endUserAdd, protConOpt, ggsnAddSig, ggsnAddUser}). +-record(sesT_updateReqV0, {tid, tidRaw, qos, recovery, flowLblData, flowLblSig, sgsnAddSig, sgsnAddUser}). +-record(sesT_updateResV0, {tid, cause, qos, recovery, flowLblData, flowLblSig, chargId, ggsnAddSig, ggsnAddUser}). +-record(sesT_echoReq, {dummy}). +-record(sesT_echoRes, {dummy}). +-record(sesT_echoReqV1, {dummy}). +-record(sesT_echoResV1, {recovery}). +-record(sesT_echoReqV0, {dummy}). +-record(sesT_echoResV0, {recovery}). +-record(masT_apnSecurity, {sgsnSel, subscribedSel, userSel, ipSpoofing}). +-record(masT_radiusServer, {radiusApn, radiusAddress, radiusMepAddress, timer, tries, secret}). +-record(masT_ipSegment, {startSegAddress, stopSegAddress, netmask}). +-record(masT_llf, {name, metric, id}). +-record(masT_apnLink, {ggsnAddress, ipSegList, ipAddressOrigin, llfConnName, mepAddress}). +-record(masT_ispSubObj, {label, value}). +-record(masT_ipcpData, {type, ipAddress, rawMessage}). +-record(masT_ipcp, {exists, code, id, ipcpList}). +-record(masT_pap, {exists, code, id, username, password}). +-record(masT_chap, {code, id, value, name}). +-record(masT_ispDevContextData, {nsapi, ipAddress, apnhandle}). +-record(masT_protocolConfigOptions, {chap, pap, ipcp}). +-record(masT_apnRadius, {radiusAddress, timer, tries, secret}). +-record(masT_outbandRadius, {gwAddress, llfConnName, primRadius, secRadius}). +-record(masT_radiusPair, {primRadius, secRadius}). +-record(masT_radiusOpt, {dummyMsisdnAuth, dummyMsisdnAcct, msisdnInAuth, msisdnInAcct, sendFullImsi, sendMccMnc, sendSelMode, sendChargingId, asynchAcct}). +-record(masT_radiusConfig, {hostApn, authPair, acctList, radiusOptions}). +-record(masT_apnConfig, {link, security, radiusConfig, primDns, secDns, dhcpAddress, indAcct, indAuth, userNameBasedSelection}). + +-endif. diff --git a/lib/hipe/test/bs_SUITE_data/bs_des.erl b/lib/hipe/test/bs_SUITE_data/bs_des.erl new file mode 100644 index 0000000000..9c495d37ad --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_des.erl @@ -0,0 +1,734 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_des.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : An implementation of the DES Encryption/Descryption +%%% algorithm using Erlang binaries. +%%% +%%% Created : 14 Apr 2004 +%%%------------------------------------------------------------------- +-module(bs_des). + +-export([encode/2, decode/2, test/0]). + +-define(ITERATIONS, 42). %% for benchmarking use a higher number + +test() -> + Bin = <<1:64>>, + Size= byte_size(Bin), + Key = <<4704650607608769871263876:64>>, + Jumbled = run_encode(?ITERATIONS, Bin, Key), + Unjumbled = run_decode(?ITERATIONS, Jumbled, Key), + <<Bin:Size/binary,_/binary>> = Unjumbled, + ok. + +run_encode(1, Bin, Key) -> + encode(Bin, Key); +run_encode(N, Bin, Key) -> + encode(Bin, Key), + run_encode(N-1, Bin, Key). + +run_decode(1, Bin, Key) -> + decode(Bin, Key); +run_decode(N, Bin, Key) -> + decode(Bin, Key), + run_decode(N-1, Bin, Key). + +encode(Data, Key) -> + Keys = schedule(Key), + list_to_binary(encode_data(Data, Keys)). + +decode(Data, Key) -> + Keys = lists:reverse(schedule(Key)), + list_to_binary(decode_data(Data, Keys)). + +encode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(des_core(ip(Data), Keys))|encode_data(Rest, Keys)]; +encode_data(<<Rest/binary>>, Keys) -> + case byte_size(Rest) of + 0 -> []; + X -> + Y = 8 - X, + Data = <<Rest/binary, 0:Y/integer-unit:8>>, + [ipinv(des_core(ip(Data), Keys))] + end. + +decode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(dechiper(ip(Data), Keys))|decode_data(Rest, Keys)]; +decode_data(_, _Keys) -> + []. + +schedule(Key) -> + NewKey = pc1(Key), + subkeys(NewKey, 1). + +subkeys(_Key, 17) -> + []; +subkeys(Key, N) -> + TmpKey = + case rotate(N) of + 1 -> + <<X1:1, L:27, X2:1, R:27>> = Key, + <<L:27, X1:1, R:27, X2:1>>; + 2 -> + <<X1:2, L:26, X2:2, R:26>> = Key, + <<L:26, X1:2, R:26, X2:2>> + end, + [pc2(TmpKey)|subkeys(TmpKey, N+1)]. + +pc2(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + _I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, _I18:1, I19:1, I20:1, I21:1, _I22:1, I23:1, I24:1, + _I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, _I35:1, I36:1, I37:1, _I38:1, I39:1, I40:1, + I41:1, I42:1, _I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, _I54:1, I55:1, I56:1>>) -> + <<I14:1, I17:1, I11:1, I24:1, I1:1, I5:1, I3:1, I28:1, + I15:1, I6:1, I21:1, I10:1, I23:1, I19:1, I12:1, I4:1, + I26:1, I8:1, I16:1, I7:1, I27:1, I20:1, I13:1, I2:1, + I41:1, I52:1, I31:1, I37:1, I47:1, I55:1, I30:1, I40:1, + I51:1, I45:1, I33:1, I48:1, I44:1, I49:1, I39:1, I56:1, + I34:1, I53:1, I46:1, I42:1, I50:1, I36:1, I29:1, I32:1>>. + +pc1(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, _:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, _:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, _:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, _:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, _:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, _:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, _:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, _:1>>) -> + <<I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I60:1, I52:1, I44:1, I36:1, I63:1, I55:1, I47:1, I39:1, + I31:1, I23:1, I15:1, I7:1, I62:1, I54:1, I46:1, I38:1, + I30:1, I22:1, I14:1, I6:1, I61:1, I53:1, I45:1, I37:1, + I29:1, I21:1, I13:1, I5:1, I28:1, I20:1, I12:1, I4:1>>. + +ip(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>) -> + <<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>. + +ipinv(<<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>) -> + <<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>. + +dechiper(<<L:4/binary, R:4/binary>>, Keys) -> + dechiper(L, R, Keys, 16). + +dechiper(L, R, [], 0) -> + <<L:4/binary, R:4/binary>>; +dechiper(L, R, [Key|Rest], I) -> + NewL = ebit(L), + XorL = xor48(NewL, Key), + Sboxed = sboxing(XorL), + Ped = p(Sboxed), + EndL = xor32(Ped, R), + dechiper(EndL, L, Rest, I-1). + +des_core(<<L:4/binary, R:4/binary>>, Keys) -> + des_core(L, R, Keys, 0). + +des_core(L, R, [], 16) -> + <<L:4/binary, R:4/binary>>; +des_core(L, R, [Key|Rest], I) when I<16 -> + NewR = ebit(R), + XorR = xor48(NewR, Key), + Sboxed = sboxing(XorR), + Ped = p(Sboxed), + EndR = xor32(Ped, L), + des_core(R, EndR, Rest, I+1). + +ebit(<<I1:1, I2:2, I3:2,I4:2,I5:2,I6:2, + I7:2,I8:2,I9:2,I10:2,I11:2,I12:2, + I13:2,I14:2,I15:2,I16:2,I17:1>>) -> + <<I17:1, I1:1, I2:2, I3:2, I3:2, + I4:2, I5:2, I5:2, I6:2, + I7:2, I7:2, I8:2, I9:2, + I9:2, I10:2, I11:2, I11:2, + I12:2, I13:2, I13:2, I14:2, + I15:2, I15:2, I16:2, I17:1, I1:1>>. + +p(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1>>) -> + <<I16:1, I7:1, I20:1, I21:1, I29:1, I12:1, I28:1, I17:1, + I1:1, I15:1, I23:1, I26:1, I5:1, I18:1, I31:1, I10:1, + I2:1, I8:1, I24:1, I14:1, I32:1, I27:1, I3:1, I9:1, + I19:1, I13:1, I30:1, I6:1, I22:1, I11:1, I4:1, I25:1>>. + +rotate(1) -> 1; +rotate(2) -> 1; +rotate(9) -> 1; +rotate(16) -> 1; +rotate(N) when N>0, N<17 -> 2. + +%% xor64(<<I1:16, I2:16, I3:16, I4:16>>,<<J1:16, J2:16, J3:16, J4:16>>) -> +%% K1 = I1 bxor J1, +%% K2 = I2 bxor J2, +%% K3 = I3 bxor J3, +%% K4 = I4 bxor J4, +%% <<K1:16, K2:16, K3:16, K4:16>>. + +xor48(<<I1:16, I2:16, I3:16>>,<<J1:16, J2:16, J3:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + K3 = I3 bxor J3, + <<K1:16, K2:16, K3:16>>. + +xor32(<<I1:16, I2:16>>,<<J1:16, J2:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + <<K1:16, K2:16>>. + +sboxing(<<A1:6, A2:6, A3:6, A4:6, A5:6, A6:6, A7:6, A8:6>>) -> + S1 = sbox(A1, 1), + S2 = sbox(A2, 2), + S3 = sbox(A3, 3), + S4 = sbox(A4, 4), + S5 = sbox(A5, 5), + S6 = sbox(A6, 6), + S7 = sbox(A7, 7), + S8 = sbox(A8, 8), + <<S1:4,S2:4,S3:4,S4:4,S5:4,S6:4,S7:4,S8:4>>. + +sbox(0,1) -> 14; +sbox(1,1) -> 0; +sbox(2,1) -> 4; +sbox(3,1) -> 15; +sbox(4,1) -> 13; +sbox(5,1) -> 7; +sbox(6,1) -> 1; +sbox(7,1) -> 4; +sbox(8,1) -> 2; +sbox(9,1) -> 14; +sbox(10,1) -> 15; +sbox(11,1) -> 2; +sbox(12,1) -> 11; +sbox(13,1) -> 13; +sbox(14,1) -> 8; +sbox(15,1) -> 1; +sbox(16,1) -> 3; +sbox(17,1) -> 10; +sbox(18,1) -> 10; +sbox(19,1) -> 6; +sbox(20,1) -> 6; +sbox(21,1) -> 12; +sbox(22,1) -> 12; +sbox(23,1) -> 11; +sbox(24,1) -> 5; +sbox(25,1) -> 9; +sbox(26,1) -> 9; +sbox(27,1) -> 5; +sbox(28,1) -> 0; +sbox(29,1) -> 3; +sbox(30,1) -> 7; +sbox(31,1) -> 8; +sbox(32,1) -> 4; +sbox(33,1) -> 15; +sbox(34,1) -> 1; +sbox(35,1) -> 12; +sbox(36,1) -> 14; +sbox(37,1) -> 8; +sbox(38,1) -> 8; +sbox(39,1) -> 2; +sbox(40,1) -> 13; +sbox(41,1) -> 4; +sbox(42,1) -> 6; +sbox(43,1) -> 9; +sbox(44,1) -> 2; +sbox(45,1) -> 1; +sbox(46,1) -> 11; +sbox(47,1) -> 7; +sbox(48,1) -> 15; +sbox(49,1) -> 5; +sbox(50,1) -> 12; +sbox(51,1) -> 11; +sbox(52,1) -> 9; +sbox(53,1) -> 3; +sbox(54,1) -> 7; +sbox(55,1) -> 14; +sbox(56,1) -> 3; +sbox(57,1) -> 10; +sbox(58,1) -> 10; +sbox(59,1) -> 0; +sbox(60,1) -> 5; +sbox(61,1) -> 6; +sbox(62,1) -> 0; +sbox(63,1) -> 13; +sbox(0,2) -> 15; +sbox(1,2) -> 3; +sbox(2,2) -> 1; +sbox(3,2) -> 13; +sbox(4,2) -> 8; +sbox(5,2) -> 4; +sbox(6,2) -> 14; +sbox(7,2) -> 7; +sbox(8,2) -> 6; +sbox(9,2) -> 15; +sbox(10,2) -> 11; +sbox(11,2) -> 2; +sbox(12,2) -> 3; +sbox(13,2) -> 8; +sbox(14,2) -> 4; +sbox(15,2) -> 14; +sbox(16,2) -> 9; +sbox(17,2) -> 12; +sbox(18,2) -> 7; +sbox(19,2) -> 0; +sbox(20,2) -> 2; +sbox(21,2) -> 1; +sbox(22,2) -> 13; +sbox(23,2) -> 10; +sbox(24,2) -> 12; +sbox(25,2) -> 6; +sbox(26,2) -> 0; +sbox(27,2) -> 9; +sbox(28,2) -> 5; +sbox(29,2) -> 11; +sbox(30,2) -> 10; +sbox(31,2) -> 5; +sbox(32,2) -> 0; +sbox(33,2) -> 13; +sbox(34,2) -> 14; +sbox(35,2) -> 8; +sbox(36,2) -> 7; +sbox(37,2) -> 10; +sbox(38,2) -> 11; +sbox(39,2) -> 1; +sbox(40,2) -> 10; +sbox(41,2) -> 3; +sbox(42,2) -> 4; +sbox(43,2) -> 15; +sbox(44,2) -> 13; +sbox(45,2) -> 4; +sbox(46,2) -> 1; +sbox(47,2) -> 2; +sbox(48,2) -> 5; +sbox(49,2) -> 11; +sbox(50,2) -> 8; +sbox(51,2) -> 6; +sbox(52,2) -> 12; +sbox(53,2) -> 7; +sbox(54,2) -> 6; +sbox(55,2) -> 12; +sbox(56,2) -> 9; +sbox(57,2) -> 0; +sbox(58,2) -> 3; +sbox(59,2) -> 5; +sbox(60,2) -> 2; +sbox(61,2) -> 14; +sbox(62,2) -> 15; +sbox(63,2) -> 9; +sbox(0,3) -> 10; +sbox(1,3) -> 13; +sbox(2,3) -> 0; +sbox(3,3) -> 7; +sbox(4,3) -> 9; +sbox(5,3) -> 0; +sbox(6,3) -> 14; +sbox(7,3) -> 9; +sbox(8,3) -> 6; +sbox(9,3) -> 3; +sbox(10,3) -> 3; +sbox(11,3) -> 4; +sbox(12,3) -> 15; +sbox(13,3) -> 6; +sbox(14,3) -> 5; +sbox(15,3) -> 10; +sbox(16,3) -> 1; +sbox(17,3) -> 2; +sbox(18,3) -> 13; +sbox(19,3) -> 8; +sbox(20,3) -> 12; +sbox(21,3) -> 5; +sbox(22,3) -> 7; +sbox(23,3) -> 14; +sbox(24,3) -> 11; +sbox(25,3) -> 12; +sbox(26,3) -> 4; +sbox(27,3) -> 11; +sbox(28,3) -> 2; +sbox(29,3) -> 15; +sbox(30,3) -> 8; +sbox(31,3) -> 1; +sbox(32,3) -> 13; +sbox(33,3) -> 1; +sbox(34,3) -> 6; +sbox(35,3) -> 10; +sbox(36,3) -> 4; +sbox(37,3) -> 13; +sbox(38,3) -> 9; +sbox(39,3) -> 0; +sbox(40,3) -> 8; +sbox(41,3) -> 6; +sbox(42,3) -> 15; +sbox(43,3) -> 9; +sbox(44,3) -> 3; +sbox(45,3) -> 8; +sbox(46,3) -> 0; +sbox(47,3) -> 7; +sbox(48,3) -> 11; +sbox(49,3) -> 4; +sbox(50,3) -> 1; +sbox(51,3) -> 15; +sbox(52,3) -> 2; +sbox(53,3) -> 14; +sbox(54,3) -> 12; +sbox(55,3) -> 3; +sbox(56,3) -> 5; +sbox(57,3) -> 11; +sbox(58,3) -> 10; +sbox(59,3) -> 5; +sbox(60,3) -> 14; +sbox(61,3) -> 2; +sbox(62,3) -> 7; +sbox(63,3) -> 12; +sbox(0,4) -> 7; +sbox(1,4) -> 13; +sbox(2,4) -> 13; +sbox(3,4) -> 8; +sbox(4,4) -> 14; +sbox(5,4) -> 11; +sbox(6,4) -> 3; +sbox(7,4) -> 5; +sbox(8,4) -> 0; +sbox(9,4) -> 6; +sbox(10,4) -> 6; +sbox(11,4) -> 15; +sbox(12,4) -> 9; +sbox(13,4) -> 0; +sbox(14,4) -> 10; +sbox(15,4) -> 3; +sbox(16,4) -> 1; +sbox(17,4) -> 4; +sbox(18,4) -> 2; +sbox(19,4) -> 7; +sbox(20,4) -> 8; +sbox(21,4) -> 2; +sbox(22,4) -> 5; +sbox(23,4) -> 12; +sbox(24,4) -> 11; +sbox(25,4) -> 1; +sbox(26,4) -> 12; +sbox(27,4) -> 10; +sbox(28,4) -> 4; +sbox(29,4) -> 14; +sbox(30,4) -> 15; +sbox(31,4) -> 9; +sbox(32,4) -> 10; +sbox(33,4) -> 3; +sbox(34,4) -> 6; +sbox(35,4) -> 15; +sbox(36,4) -> 9; +sbox(37,4) -> 0; +sbox(38,4) -> 0; +sbox(39,4) -> 6; +sbox(40,4) -> 12; +sbox(41,4) -> 10; +sbox(42,4) -> 11; +sbox(43,4) -> 1; +sbox(44,4) -> 7; +sbox(45,4) -> 13; +sbox(46,4) -> 13; +sbox(47,4) -> 8; +sbox(48,4) -> 15; +sbox(49,4) -> 9; +sbox(50,4) -> 1; +sbox(51,4) -> 4; +sbox(52,4) -> 3; +sbox(53,4) -> 5; +sbox(54,4) -> 14; +sbox(55,4) -> 11; +sbox(56,4) -> 5; +sbox(57,4) -> 12; +sbox(58,4) -> 2; +sbox(59,4) -> 7; +sbox(60,4) -> 8; +sbox(61,4) -> 2; +sbox(62,4) -> 4; +sbox(63,4) -> 14; +sbox(0,5) -> 2; +sbox(1,5) -> 14; +sbox(2,5) -> 12; +sbox(3,5) -> 11; +sbox(4,5) -> 4; +sbox(5,5) -> 2; +sbox(6,5) -> 1; +sbox(7,5) -> 12; +sbox(8,5) -> 7; +sbox(9,5) -> 4; +sbox(10,5) -> 10; +sbox(11,5) -> 7; +sbox(12,5) -> 11; +sbox(13,5) -> 13; +sbox(14,5) -> 6; +sbox(15,5) -> 1; +sbox(16,5) -> 8; +sbox(17,5) -> 5; +sbox(18,5) -> 5; +sbox(19,5) -> 0; +sbox(20,5) -> 3; +sbox(21,5) -> 15; +sbox(22,5) -> 15; +sbox(23,5) -> 10; +sbox(24,5) -> 13; +sbox(25,5) -> 3; +sbox(26,5) -> 0; +sbox(27,5) -> 9; +sbox(28,5) -> 14; +sbox(29,5) -> 8; +sbox(30,5) -> 9; +sbox(31,5) -> 6; +sbox(32,5) -> 4; +sbox(33,5) -> 11; +sbox(34,5) -> 2; +sbox(35,5) -> 8; +sbox(36,5) -> 1; +sbox(37,5) -> 12; +sbox(38,5) -> 11; +sbox(39,5) -> 7; +sbox(40,5) -> 10; +sbox(41,5) -> 1; +sbox(42,5) -> 13; +sbox(43,5) -> 14; +sbox(44,5) -> 7; +sbox(45,5) -> 2; +sbox(46,5) -> 8; +sbox(47,5) -> 13; +sbox(48,5) -> 15; +sbox(49,5) -> 6; +sbox(50,5) -> 9; +sbox(51,5) -> 15; +sbox(52,5) -> 12; +sbox(53,5) -> 0; +sbox(54,5) -> 5; +sbox(55,5) -> 9; +sbox(56,5) -> 6; +sbox(57,5) -> 10; +sbox(58,5) -> 3; +sbox(59,5) -> 4; +sbox(60,5) -> 0; +sbox(61,5) -> 5; +sbox(62,5) -> 14; +sbox(63,5) -> 3; +sbox(0,6) -> 12; +sbox(1,6) -> 10; +sbox(2,6) -> 1; +sbox(3,6) -> 15; +sbox(4,6) -> 10; +sbox(5,6) -> 4; +sbox(6,6) -> 15; +sbox(7,6) -> 2; +sbox(8,6) -> 9; +sbox(9,6) -> 7; +sbox(10,6) -> 2; +sbox(11,6) -> 12; +sbox(12,6) -> 6; +sbox(13,6) -> 9; +sbox(14,6) -> 8; +sbox(15,6) -> 5; +sbox(16,6) -> 0; +sbox(17,6) -> 6; +sbox(18,6) -> 13; +sbox(19,6) -> 1; +sbox(20,6) -> 3; +sbox(21,6) -> 13; +sbox(22,6) -> 4; +sbox(23,6) -> 14; +sbox(24,6) -> 14; +sbox(25,6) -> 0; +sbox(26,6) -> 7; +sbox(27,6) -> 11; +sbox(28,6) -> 5; +sbox(29,6) -> 3; +sbox(30,6) -> 11; +sbox(31,6) -> 8; +sbox(32,6) -> 9; +sbox(33,6) -> 4; +sbox(34,6) -> 14; +sbox(35,6) -> 3; +sbox(36,6) -> 15; +sbox(37,6) -> 2; +sbox(38,6) -> 5; +sbox(39,6) -> 12; +sbox(40,6) -> 2; +sbox(41,6) -> 9; +sbox(42,6) -> 8; +sbox(43,6) -> 5; +sbox(44,6) -> 12; +sbox(45,6) -> 15; +sbox(46,6) -> 3; +sbox(47,6) -> 10; +sbox(48,6) -> 7; +sbox(49,6) -> 11; +sbox(50,6) -> 0; +sbox(51,6) -> 14; +sbox(52,6) -> 4; +sbox(53,6) -> 1; +sbox(54,6) -> 10; +sbox(55,6) -> 7; +sbox(56,6) -> 1; +sbox(57,6) -> 6; +sbox(58,6) -> 13; +sbox(59,6) -> 0; +sbox(60,6) -> 11; +sbox(61,6) -> 8; +sbox(62,6) -> 6; +sbox(63,6) -> 13; +sbox(0,7) -> 4; +sbox(1,7) -> 13; +sbox(2,7) -> 11; +sbox(3,7) -> 0; +sbox(4,7) -> 2; +sbox(5,7) -> 11; +sbox(6,7) -> 14; +sbox(7,7) -> 7; +sbox(8,7) -> 15; +sbox(9,7) -> 4; +sbox(10,7) -> 0; +sbox(11,7) -> 9; +sbox(12,7) -> 8; +sbox(13,7) -> 1; +sbox(14,7) -> 13; +sbox(15,7) -> 10; +sbox(16,7) -> 3; +sbox(17,7) -> 14; +sbox(18,7) -> 12; +sbox(19,7) -> 3; +sbox(20,7) -> 9; +sbox(21,7) -> 5; +sbox(22,7) -> 7; +sbox(23,7) -> 12; +sbox(24,7) -> 5; +sbox(25,7) -> 2; +sbox(26,7) -> 10; +sbox(27,7) -> 15; +sbox(28,7) -> 6; +sbox(29,7) -> 8; +sbox(30,7) -> 1; +sbox(31,7) -> 6; +sbox(32,7) -> 1; +sbox(33,7) -> 6; +sbox(34,7) -> 4; +sbox(35,7) -> 11; +sbox(36,7) -> 11; +sbox(37,7) -> 13; +sbox(38,7) -> 13; +sbox(39,7) -> 8; +sbox(40,7) -> 12; +sbox(41,7) -> 1; +sbox(42,7) -> 3; +sbox(43,7) -> 4; +sbox(44,7) -> 7; +sbox(45,7) -> 10; +sbox(46,7) -> 14; +sbox(47,7) -> 7; +sbox(48,7) -> 10; +sbox(49,7) -> 9; +sbox(50,7) -> 15; +sbox(51,7) -> 5; +sbox(52,7) -> 6; +sbox(53,7) -> 0; +sbox(54,7) -> 8; +sbox(55,7) -> 15; +sbox(56,7) -> 0; +sbox(57,7) -> 14; +sbox(58,7) -> 5; +sbox(59,7) -> 2; +sbox(60,7) -> 9; +sbox(61,7) -> 3; +sbox(62,7) -> 2; +sbox(63,7) -> 12; +sbox(0,8) -> 13; +sbox(1,8) -> 1; +sbox(2,8) -> 2; +sbox(3,8) -> 15; +sbox(4,8) -> 8; +sbox(5,8) -> 13; +sbox(6,8) -> 4; +sbox(7,8) -> 8; +sbox(8,8) -> 6; +sbox(9,8) -> 10; +sbox(10,8) -> 15; +sbox(11,8) -> 3; +sbox(12,8) -> 11; +sbox(13,8) -> 7; +sbox(14,8) -> 1; +sbox(15,8) -> 4; +sbox(16,8) -> 10; +sbox(17,8) -> 12; +sbox(18,8) -> 9; +sbox(19,8) -> 5; +sbox(20,8) -> 3; +sbox(21,8) -> 6; +sbox(22,8) -> 14; +sbox(23,8) -> 11; +sbox(24,8) -> 5; +sbox(25,8) -> 0; +sbox(26,8) -> 0; +sbox(27,8) -> 14; +sbox(28,8) -> 12; +sbox(29,8) -> 9; +sbox(30,8) -> 7; +sbox(31,8) -> 2; +sbox(32,8) -> 7; +sbox(33,8) -> 2; +sbox(34,8) -> 11; +sbox(35,8) -> 1; +sbox(36,8) -> 4; +sbox(37,8) -> 14; +sbox(38,8) -> 1; +sbox(39,8) -> 7; +sbox(40,8) -> 9; +sbox(41,8) -> 4; +sbox(42,8) -> 12; +sbox(43,8) -> 10; +sbox(44,8) -> 14; +sbox(45,8) -> 8; +sbox(46,8) -> 2; +sbox(47,8) -> 13; +sbox(48,8) -> 0; +sbox(49,8) -> 15; +sbox(50,8) -> 6; +sbox(51,8) -> 12; +sbox(52,8) -> 10; +sbox(53,8) -> 9; +sbox(54,8) -> 13; +sbox(55,8) -> 0; +sbox(56,8) -> 15; +sbox(57,8) -> 3; +sbox(58,8) -> 3; +sbox(59,8) -> 5; +sbox(60,8) -> 5; +sbox(61,8) -> 6; +sbox(62,8) -> 8; +sbox(63,8) -> 11. diff --git a/lib/hipe/test/bs_SUITE_data/bs_extract.erl b/lib/hipe/test/bs_SUITE_data/bs_extract.erl new file mode 100644 index 0000000000..0492689fa8 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_extract.erl @@ -0,0 +1,94 @@ +%% -*- erlang-indent-level: 2 -*- +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Among testing other things, this module shows why performing LCM on +%% SPARC is currently problematic. SPARC does not mark untagged values +%% as dead when they are live over function calls which in turn causes +%% them to be traced by the garbage collector leading to crashes. +%% +%% A simple way to get this behaviour is to compile just the function +%% +%% {bsextract,tid_internal_storage,2} +%% +%% with the compiler option "rtl_lcm" on and without. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(bs_extract). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok, {mvsgT_imsi, <<81,67,101,7,0,0,0,240>>}}). + +test() -> + ?RES = extract_v0_opt(1000, ?PDU), + ok. + +extract_v0_opt(0, Pdu) -> + get_external_id(Pdu); +extract_v0_opt(N, Pdu) -> + {ok,_} = get_external_id(Pdu), + extract_v0_opt(N-1, Pdu). + +get_external_id(<<0:3,_:4,0:1,1:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + _TID:8/binary-unit:8,_InformationElements/binary>>) -> + {echo,#sesT_echoReqV0{},SequenceNumber}; +%% Create PDP Context Request +%% GTP97, SNN=0 +%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,16:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,18:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,20:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Error handling: GTP Message Too Short +%%% Error handling: Unknown GTP Signalling message. +%%% Error handling: Unexpected GTP Signalling message. +get_external_id(_GTP_Message) -> + fault. + +%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%% extract_imsi/1 +%% Get the IMSI element from TID +extract_imsi(TID) -> + {ok,#mvsgT_tid{imsi=IMSI}} = tid_internal_storage(TID,[]), + {ok,IMSI}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value=Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_flatb.erl b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl new file mode 100644 index 0000000000..6163917965 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl @@ -0,0 +1,29 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------------- +%% Program which resulted in a badarg crash when compiled to native code. +%% The problem was that hipe_icode_primops was stating that the primop +%% {bs_start_match, ok_matchstate} could not fail which made the icode_type +%% pass removing the third clause of flatb/1. +%% +%% (The program was working correctly with hipe option 'no_icode_type'.) +%% +%% Reported by Andreas Sandberg on 3/1/2011 and fixed by Kostis on 5/1/2011 +%% with the help of Per Gustafsson. +%% -------------------------------------------------------------------------- +-module(bs_flatb). + +-export([hipe_options/0, test/0]). + +hipe_options() -> + [icode_type]. + +test() -> + [] = flatb([<<>>], []), + ok. + +flatb(<<X:8, Rest/binary>>, Acc) -> + flatb(Rest, [X|Acc]); +flatb(<<>>, Acc) -> + Acc; +flatb([V], Acc) -> + flatb(V, Acc). diff --git a/lib/hipe/test/bs_SUITE_data/bs_id3.erl b/lib/hipe/test/bs_SUITE_data/bs_id3.erl new file mode 100644 index 0000000000..a6152f05cd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_id3.erl @@ -0,0 +1,75 @@ +%% -*- erlang-indent-level: 2 -*- +%%========================================================================== +%% From: Tomas Stejskal -- 23/02/2008 +%% I've found some strange behavior regarding binary matching. The module's +%% purpose is reading an id3 version 1 or version 1.1 tag from an mp3 bin. +%% When I use the function read_v1_or_v11_tag on a mp3 binary containing +%% version 1 tag, it returns an error. However, when the function +%% read_only_v1_tag is applied on the same file, it reads the tag data +%% correctly. The only difference between these two functions is that the +%% former has an extra branch to read version 1.1 tag. +%% This was a BEAM compiler bug which was fixed by a patch to beam_dead. +%%========================================================================== + +-module(bs_id3). + +-export([test/0]). + +-define(BIN, <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,68,97,110,105,101,108,32,76,97,110, + 100,97,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,66,101,115,116, + 32,79,102,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 50,48,48,48,50,48,48,48,32,45,32,66,101,115,116,32,79,102, + 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,12>>). + +test() -> + R1 = parse_only_v1_tag(?BIN), + R2 = parse_v1_or_v11_tag(?BIN), + %% io:format("~p\n~p\n", [R1, R2]), + R1 = R2, % crash if not equal + ok. + +parse_only_v1_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_only_v1_tag(_) -> + error. + +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:28/binary, + 0:8, Track:8, _Genre:8>>) -> + {ok, + {"ID3v1.1", + [{track, Track}, {title, trim(Title)}, + {artist, trim(Artist)}, {album, trim(Album)}]}}; +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_v1_or_v11_tag(_) -> + error. + +trim(Bin) -> + list_to_binary(trim_blanks(binary_to_list(Bin))). + +trim_blanks(L) -> + lists:reverse(skip_blanks_and_zero(lists:reverse(L))). + +skip_blanks_and_zero([$\s|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero([0|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero(L) -> + L. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl new file mode 100644 index 0000000000..8194d878b8 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl @@ -0,0 +1,175 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_match.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Performs simple matching and construction of binaries +%%% TODO : Add binary and float tests +%%% Created : 20 Feb 2004 +%%%------------------------------------------------------------------- +-module(bs_match). + +-export([test/0]). + +test() -> + Funs = [fun test_aligned/0, fun test_unaligned/0, + fun test_zero_tail/0, fun test_integer_matching/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%------------------------------------------------------------------- +%% Test aligned accesses + +test_aligned() -> + 10 = aligned_skip_bits_all(1, <<10,11,12>>), + ok = aligned(). + +aligned_skip_bits_all(N, Bin) -> + <<X:N/integer-unit:8, _/binary>> = Bin, + X. + +aligned() -> + Tail1 = mkbin([]), + {258, Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091, Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + Tail3 = mkbin(lists:seq(0, 19)), + {0, Tail1} = get_dyn_tail_used(Tail1, 0), + {0, Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73, Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +al_get_tail_used(<<A:16,T/binary>>) -> {A, T}. + +al_get_tail_unused(<<A:16,_/binary>>) -> A. + +%%------------------------------------------------------------------- +%% Test unaligned accesses + +test_unaligned() -> + 10 = unaligned_skip_bits_all(8, <<10,11,12>>), + ok = unaligned(). + +unaligned_skip_bits_all(N, Bin) -> + <<X:N, _/binary>> = Bin, + X. + +unaligned() -> + {'EXIT', {function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT', {function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + ok. + +get_tail_used(<<A:1, T/binary>>) -> {A, T}. + +get_tail_unused(<<A:15, _/binary>>) -> A. + +get_dyn_tail_used(Bin, Sz) -> + <<A:Sz, T/binary>> = Bin, + {A,T}. + +get_dyn_tail_unused(Bin, Sz) -> + <<A:Sz, _T/binary>> = Bin, + A. + +%%------------------------------------------------------------------- +%% Test zero tail + +test_zero_tail() -> + 42 = zt8(mkbin([42])), + {'EXIT', {function_clause, _}} = (catch zt8(mkbin([1,2]))), + {'EXIT', {function_clause, _}} = (catch zt44(mkbin([1,2]))), + ok. + +zt8(<<A:8>>) -> A. + +zt44(<<_:4,_:4>>) -> ok. + +%%------------------------------------------------------------------- +%% Test integer matching + +test_integer_matching() -> + ok = test_static_integer_matching_1(), + ok = test_static_integer_matching_2(), + ok = test_static_integer_matching_3(), + ok = test_static_integer_matching_4(), + DynFun = fun (N) -> ok = test_dynamic_integer_matching(N) end, + lists:foreach(DynFun, [28, 27, 9, 17, 25, 8, 16, 24, 32]). + +test_static_integer_matching_1() -> + <<0:6, -25:28/integer-signed, 0:6>> = s11(), + <<0:6, -25:28/integer-little-signed, 0:6>> = s12(), + <<0:6, 25:28/integer-little, 0:6>> = s13(), + <<0:6, 25:28, 0:6>> = s14(), + ok. + +s11() -> + <<0:6, -25:28/integer-signed, 0:6>>. +s12() -> + <<0:6, -25:28/integer-little-signed, 0:6>>. +s13() -> + <<0:6, 25:28/integer-little, 0:6>>. +s14() -> + <<0:6, 25:28, 0:6>>. + +test_static_integer_matching_2() -> + <<0:6, -25:20/integer-signed, 0:6>> = s21(), + <<0:6, -25:20/integer-little-signed, 0:6>> = s22(), + <<0:6, 25:20/integer-little, 0:6>> = s23(), + <<0:6, 25:20, 0:6>> = s24(), + ok. + +s21() -> + <<0:6, -25:20/integer-signed, 0:6>>. +s22() -> + <<0:6, -25:20/integer-little-signed, 0:6>>. +s23() -> + <<0:6, 25:20/integer-little, 0:6>>. +s24() -> + <<0:6, 25:20, 0:6>>. + +test_static_integer_matching_3() -> + <<0:6, -25:12/integer-signed, 0:6>> = s31(), + <<0:6, -25:12/integer-little-signed, 0:6>> = s32(), + <<0:6, 25:12/integer-little, 0:6>> = s33(), + <<0:6, 25:12, 0:6>> = s34(), + ok. + +s31() -> + <<0:6, -25:12/integer-signed, 0:6>>. +s32() -> + <<0:6, -25:12/integer-little-signed, 0:6>>. +s33() -> + <<0:6, 25:12/integer-little, 0:6>>. +s34() -> + <<0:6, 25:12, 0:6>>. + +test_static_integer_matching_4() -> + <<0:6, -3:4/integer-signed, 0:6>> = s41(), + <<0:6, -3:4/integer-little-signed, 0:6>> = s42(), + <<0:6, 7:4/integer-little, 0:6>> = s43(), + <<0:6, 7:4, 0:6>> = s44(), + ok. + +s41() -> + <<0:6, -3:4/integer-signed, 0:6>>. +s42() -> + <<0:6, -3:4/integer-little-signed, 0:6>>. +s43() -> + <<0:6, 7:4/integer-little, 0:6>>. +s44() -> + <<0:6, 7:4, 0:6>>. + +test_dynamic_integer_matching(N) -> + S = 32 - N, + <<-12:N/integer-signed, 0:S>> = <<-12:N/integer-signed, 0:S>>, + <<-12:N/integer-little-signed, 0:S>> = <<-12:N/integer-little-signed, 0:S>>, + <<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>, + <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_native_float.erl b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl new file mode 100644 index 0000000000..15fe0bf0c6 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl @@ -0,0 +1,22 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% File : bs_native_float.erl +%% Author : Kostis Sagonas +%% Description : Test sent by Bjorn Gustavsson to report a bug in the +%% handling of the 'native' endian specifier. +%% Created : 28 Nov 2004 +%%------------------------------------------------------------------- +-module(bs_native_float). + +-export([test/0]). + +test() -> + BeamRes = mk_bin(1.0, 2.0, 3.0), + hipe:c(?MODULE), %% Original was: hipe:c({?MODULE,vs_to_bin,1}, [o2]), + HipeRes = mk_bin(1.0, 2.0, 3.0), + %% io:format("Beam result = ~w\nHiPE result = ~w\n", [BeamRes,HipeRes]), + BeamRes = HipeRes, + ok. + +mk_bin(X, Y, Z) -> + <<X:64/native-float, Y:64/native-float, Z:64/native-float>>. diff --git a/lib/hipe/test/bs_SUITE_data/bs_orber.erl b/lib/hipe/test/bs_SUITE_data/bs_orber.erl new file mode 100644 index 0000000000..c80ab8928d --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_orber.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks that labels are handled properly from Core +%%% Created : 2 Nov 2004 +%%%------------------------------------------------------------------- +-module(bs_orber). + +-export([test/0]). + +test() -> + 1 = dec_giop_message_header(<<1,1:32/little-integer>>), + 1 = dec_giop_message_header(<<0,1:32/big-integer>>), + {2, 1} = dec_giop_message_header(<<2,1:32/little-integer>>), + {3, 1} = dec_giop_message_header(<<3,1:32/big-integer>>), + ok. + +dec_giop_message_header(<<1:8, MessSize:32/little-integer>>) -> + MessSize; +dec_giop_message_header(<<0:8, MessSize:32/big-integer>>) -> + MessSize; +dec_giop_message_header(<<Flags:8, MessSize:32/little-integer>>) when + ((Flags band 16#03) =:= 16#02) -> + {Flags, MessSize}; +dec_giop_message_header(<<Flags:8, MessSize:32/big-integer>>) -> + {Flags, MessSize}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl new file mode 100644 index 0000000000..9474ffea4a --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl @@ -0,0 +1,269 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching work +%%-------------------------------------------------------------------- +-module(bs_pmatch). + +-export([test/0]). + +test() -> + %% construct some binaries + Bin42 = <<42>>, + Bin = <<12,17,42,0,0,0>>, + BinSS = <<0,1,0,0,0>>, + %% do some pattern matching + ok = pm_const(Bin42), + <<17,42,0,0,0>> = pm_tail(Bin), + 42 = pm_little(<<0:1,42:7>>), + 42 = pm_rec(Bin), + 30 = pm_rec_acc(<<1,2,3,4,5,6,7,8,9,10>>, 0), + 42 = pm_binary_tuple(Bin42), + -1 = pm_with_illegal_float(), + %% do some pattern matching with bound segments + ok = pm_bound_var(), + ok = pm_bound_tail(), + %% do some tests with floating point numbers + ok = pm_float(), + ok = pm_float_little(), + %% do some pattern matching with segments of unknown sizes + {<<17>>, <<42,0,0,0>>} = pm_body_s(Bin, 1), + {<<17>>, <<42,0,0,0>>} = pm_body_ss(Bin, 1, 4), + {<<45>>, <<>>} = pm_size_split(<<1:16,45>>), + {<<45>>, <<46,47>>} = pm_size_split(<<1:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split(<<2:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split_2(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch pm_size_split_2(42, <<2:16,45,46,47>>)), + {<<45,46,47>>, <<48>>} = pm_sizes_split(<<16:8,3:16,45,46,47,48>>), + <<"cdef">> = pm_skip_segment(<<2:8, "abcdef">>), + -1 = pm_double_size_in_head(BinSS), + -1 = pm_double_size_in_body(BinSS), + %% and finally some cases which were problematic for various reasons + ok = pm_bigs(), + ok = pm_sean(), + ok = pm_bin8(<<1,2,3,4,5,6,7,8>>), + ok = pm_bs_match_string(), + ok = pm_till_gc(), + ok. + +%%-------------------- +%% Test cases below +%%-------------------- + +pm_const(<<42>>) -> + ok. + +pm_tail(<<12, Bin/binary>>) -> + Bin. + +pm_little(<<_:1, X:15/little>>) -> + {wrong, X}; +pm_little(<<_:1, X:7/little>>) -> + X. + +pm_rec(<<12, Bin/binary>>) -> + pm_rec(Bin); +pm_rec(<<17, Word:4/little-signed-integer-unit:8>>) -> + Word. + +pm_rec_acc(<<_:4, A:4, Rest/binary>>, Acc) -> + case Rest of + <<X, Y, 9, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Y+Acc); + <<X, 5, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Acc); + <<2, NewRest/binary>> -> + pm_rec_acc(NewRest, 1+Acc); + <<NewRest/binary>> -> + pm_rec_acc(NewRest, A+Acc) + end; +pm_rec_acc(<<>>, Acc) -> + Acc. + +pm_binary_tuple(<<X>>) -> + X; +pm_binary_tuple({Y, Z}) -> + Y + Z. + +pm_with_illegal_float() -> + Bin = <<-1:64>>, % create a binary which is illegal as float + pm_float_integer(Bin). % try to match it out as a float + +pm_float_integer(<<F:64/float>>) -> F; +pm_float_integer(<<I:64/integer-signed>>) -> I. + +%%-------------------------------------------------------------------- +%% Some tests with bound variables in segments + +pm_bound_var() -> + ok = pm_bound_var(42, 13, <<42,13>>), + no = pm_bound_var(42, 13, <<42,255>>), + no = pm_bound_var(42, 13, <<154,255>>), + ok. + +pm_bound_var(A, B, <<A:8, B:8>>) -> ok; +pm_bound_var(_, _, _) -> no. + +pm_bound_tail() -> + ok = pm_bound_tail(<<>>, <<13,14>>), + ok = pm_bound_tail(<<2,3>>, <<1,1,2,3>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,7>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,3,4>>), + no = pm_bound_tail(<<2,3>>, <<>>), + ok. + +pm_bound_tail(T, <<_:16, T/binary>>) -> ok; +pm_bound_tail(_, _) -> no. + +%%-------------------------------------------------------------------- +%% Floating point tests + +pm_float() -> + F = f1(), + G = f_one(), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + ok. + +fcmp(F1, F2) when (F1 - F2) / F2 < 0.0000001 -> ok. + +match_float(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I,F:Fsz/float,_:Tsz>> = Bin, + F. + +pm_float_little() -> + F = f2(), + G = f_one(), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + ok. + +match_float_little(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I, F:Fsz/float-little, _:Tsz>> = Bin, + F. + +make_sub_bin(Bin0) -> + Sz = byte_size(Bin0), + Bin1 = <<37,Bin0/binary,38,39>>, + <<_:8,Bin:Sz/binary,_:8,_:8>> = Bin1, + Bin. + +f1() -> 3.1415. + +f2() -> 2.7133. + +f_one() -> 1.0. + +%%-------------------------------------------------------------------- +%% Some tests using size fields specified within the binary +pm_body_s(Bin, S1) -> + <<12, B1:S1/binary, B2:4/binary>> = Bin, %% 4 is hard-coded + {B1, B2}. + +pm_body_ss(Bin, S1, S2) -> + <<12, B1:S1/binary, B2:S2/binary>> = Bin, + {B1, B2}. + +pm_size_split(<<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_size_split_2(N, <<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_sizes_split(<<N0:8, N:N0, B:N/binary, T/binary>>) -> + {B, T}. + +pm_skip_segment(<<N:8, _:N/binary, T/binary>>) -> T. + +%%-------------------------------------------------------------------- +%% Some tests using multiple occurrences of size fields +pm_double_size_in_head(<<S:16, _:S/binary, _:S/binary, _/binary>>) -> + -S. + +pm_double_size_in_body(Bin) -> + <<S:16, _:S/binary, _:S/binary, _/binary>> = Bin, + -S. + +%%-------------------------------------------------------------------- +%% matching with 64-bit integers which become big nums +-define(BIG, 16#7fffffff7fffffff). + +pm_bigs() -> + <<X:64/little>> = <<?BIG:64/little>>, + true = (X =:= big()), + <<Y:64>> = <<?BIG:64>>, + true = (Y =:= big()), + ok. + +big() -> ?BIG. + +%%-------------------------------------------------------------------- + +pm_sean() -> + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT', {function_clause, _}} = (catch sean1(<<4,5,6,7>>)), + ok. + +sean1(<<B/binary>>) when byte_size(B) < 4 -> small; +sean1(<<1, _/binary>>) -> large. + +%%-------------------------------------------------------------------- +%% Crashed on SPARC due to a bug in linear scan register allocator +pm_bin8(<<A, B, C, D, E, F, G, H>>) -> + 10 = add4(A, B, C, D), + 26 = add4(E, F, G, H), + ok. + +add4(X, Y, Z, W) -> + X + Y + Z + W. + +%%-------------------------------------------------------------------- +%% Cases that exposed bugs in the handling of bs_match_string with an +%% empty destination list. Reported on 2013/2/12 and fixed 2013/3/10. + +pm_bs_match_string() -> + Bin = <<42,42>>, + Bin = pm_match_string_head(Bin), + ok = (pm_match_string_fun())(Bin). + +pm_match_string_head(<<42, _/bits>> = B) -> B. + +pm_match_string_fun() -> + fun (<<X, _/bits>>) when X =:= 42 -> ok end. + +%%-------------------------------------------------------------------- +%% Match a lot to force a garbage collection which exposed a bug + +pm_till_gc() -> + Bin = <<16#76543210:32>>, + 16#76543210 = pm_a_lot(Bin, 1000000), + ok. + +pm_a_lot(<<X:32>>, 0) -> + X; +pm_a_lot(<<X:32>>, N) -> + pm_a_lot(<<X:32>>, N-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl new file mode 100644 index 0000000000..b280705a47 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl @@ -0,0 +1,67 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +-module(bs_pmatch_bugs). + +-export([test/0]). + +test() -> + Bin = <<"123.123">>, + <<49,50,51>> = lex_digits1(Bin, 1, []), + <<49,50,51>> = lex_digits2(Bin, 1, []), + ok = var_bind_bug(<<1, 2, 3, 4, 5, 6, 7, 8>>), + ok. + +%%-------------------------------------------------------------------- +%% One of the lex_digits functions below gave incorrect results due to +%% incorrect pattern matching compilation of binaries by the byte code +%% compiler. Fixed by Bjorn Gustavsson on 5/3/2003. +%% -------------------------------------------------------------------- +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. + +%%-------------------------------------------------------------------- +%% From: Bernard Duggan +%% Date: 11/3/2011 +%% +%% I've just run into an interesting little bit of behaviour that +%% doesn't seem quite right. erlc gives me the warning +%% +%% 43: Warning: this clause cannot match because a previous +%% clause at line 42 always matches +%% (line 42 is the "B -> wrong;" line). +%% +%% And sure enough, if you run test/0 you get 'wrong' back. +%% +%% That, in itself, is curious to me since by my understanding B should +%% be bound by the function header, and have no guarantee of being the +%% same as A. I can't see how it could be unbound. +%% +%% Doubly curious, is that if I stop using B as the size specifier of C, +%% like this: +%% +%% match(<<A:1/binary, B:8/integer, _C:1/binary, _Rest/binary>>) -> +%% +%% the warning goes away. And the result becomes 'ok' (in spite of +%% nothing in the body having changed, and the only thing changing in +%% the header being the size of an unused variable at the tail of the +%% binary). +%%-------------------------------------------------------------------- +var_bind_bug(<<A:1/binary, B:8/integer, _C:B/binary, _Rest/binary>>) -> + case A of + B -> wrong; + _ -> ok + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl new file mode 100644 index 0000000000..159227bb92 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching in guards work +%%-------------------------------------------------------------------- +-module(bs_pmatch_in_guards). + +-export([test/0]). + +test() -> + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + nope = in_guard(<<1>>, 42, b), + nope = in_guard(<<1>>, a, b), + nope = in_guard(<<1,2>>, 1, 1), + nope = in_guard(<<4,5>>, 1, 2.71), + nope = in_guard(<<4,5>>, 1, <<12,13>>), + ok. + +in_guard(Bin, A, B) when <<A:13,B:3>> == Bin -> 1; +in_guard(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2; +in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; +in_guard(_, _, _) -> nope. diff --git a/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl new file mode 100644 index 0000000000..8bc4fe5c88 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl @@ -0,0 +1,200 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +-module(bs_potpurri). + +-export([test/0]). + +test() -> + ok = integer(), + ok = signed_integer(), + ok = dynamic(), + ok = more_dynamic(), + ok = mml(), + ok. + +%% compile(Opts0) -> +%% case proplists:get_bool(core, Opts0) of +%% true -> +%% test:note(?MODULE, "disabling compilation from core - BUG"), +%% Opts = [{core,false}|Opts0]; +%% false -> +%% Opts = Opts0 +%% end, +%% hipe:c(?MODULE, Opts). + +integer() -> + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + L = [200,1,19,128,222,42,97,111,200,1,19,128,222,42,97,111], + ok = cmp128(mkbin(L), uint(L)), + ok = fun_clause(catch get_int(mkbin(lists: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. + +cmp128(<<I:128>>, I) -> ok; +cmp128(_Bin, _I) -> not_ok. + +signed_integer() -> + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])), + ok. + +sint(Bin) -> + case Bin of + <<I:8/signed>> -> I; + <<I:8/signed,_:3,_:5>> -> I; + Other -> {no_match,Other} + end. + +uint(L) -> uint(L, 0). + +uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); +uint([], Acc) -> Acc. + +dynamic() -> + ok = dynamic(mkbin([255]), 8), + ok = dynamic(mkbin([255,255]), 16), + ok = dynamic(mkbin([255,255,255]), 24), + ok = dynamic(mkbin([255,255,255,255]), 32), + ok. + +dynamic(Bin, S1) when S1 >= 0 -> + S2 = bit_size(Bin) - S1, + dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), + dynamic(Bin, S1-1); +dynamic(_Bin, _) -> ok. + +dynamic(Bin, S1, S2, A, B) -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + case Bin of + <<A:S1,B:S2>> -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + ok; + <<A1:S1,B2:S2>> -> erlang:error(badmatch, [Bin,S1,S2,A,B,A1,B2]) + end. + +more_dynamic() -> + %% Unsigned big-endian numbers. + Unsigned = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin, + Int = make_int(List, N, 0) + end, + ok = more_dynamic1(Unsigned, funny_binary(42)), + + %% Signed big-endian numbers. + Signed = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin, + case make_signed_int(List, N) of + Int -> ok; + Other -> + io:format("Bin = ~p,", [Bin]), + io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), + io:format("Expected ~p, got ~p", [Int,Other]), + exit(Other) + end + end, + ok = more_dynamic1(Signed, funny_binary(43)), + + %% Unsigned little-endian numbers. + UnsLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin, + Int = make_int(big_to_little(List, N), N, 0) + end, + more_dynamic1(UnsLittle, funny_binary(44)), + + %% Signed little-endian numbers. + SignLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin, + Little = big_to_little(List, N), + Int = make_signed_int(Little, N) + end, + ok = more_dynamic1(SignLittle, funny_binary(45)), + + ok. + +funny_binary(N) -> + B0 = erlang:md5([N]), + {B1,_B2} = split_binary(B0, byte_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). + +more_dynamic2(Action, Bin, [_|T]=List, Bef) -> + more_dynamic3(Action, Bin, List, Bef, bit_size(Bin)), + more_dynamic2(Action, Bin, T, Bef+1); +more_dynamic2(_Action, _Bin, [], _Bef) -> ok. + +more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + %% io:format("~p, ~p", [Bef,Aft-Bef]), + Action(Bin, List, Bef, Aft-Bef), + more_dynamic3(Action, Bin, List, Bef, Aft-1); +more_dynamic3(_, _, _, _, _) -> ok. + +big_to_little(List, N) -> big_to_little(List, N, []). + +big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> + big_to_little(T, N-8, [B0,B1,B2,B3,B4,B5,B6,B7|Acc]); +big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. + +make_signed_int(_List, 0) -> 0; +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). + +reversed_sublist(_List, 0, Acc) -> Acc; +reversed_sublist([H|T], N, Acc) -> reversed_sublist(T, N-1, [H|Acc]). + +two_complement_and_reverse([H|T], Carry, Acc) -> + Sum = 1 - H + Carry, + two_complement_and_reverse(T, Sum div 2, [Sum rem 2|Acc]); +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([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +fun_clause({'EXIT',{function_clause,_}}) -> ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +mml() -> + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>), + ok. + +mml_choose(<<_:8>>) -> single_byte_binary; +mml_choose(<<_:8, _T/binary>>) -> multi_byte_binary. diff --git a/lib/hipe/test/bs_SUITE_data/bs_remove3.erl b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl new file mode 100644 index 0000000000..a98b0b5b28 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl @@ -0,0 +1,104 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_remove3.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 13 Apr 2004 by Per Gustafsson +%%%------------------------------------------------------------------- +-module(bs_remove3). + +-export([test/0]). + +-define(A, <<56,0,120,0,0,31,255,255,102,42,12,0,3,3,16,5,24,3,240,0,0,32,0,196, + 2,128,4,0,255,255,254,33,68,96,0,8,8,213,40,192,31,196,0,4,0,0>>). +-define(B, <<28,32,0,96,0,8,0,7,255,255,212,33,98,12,0,0,1,0,48,72,66,3,0,7,240, + 64,0,0,8,0,0,224,0,10,128,0,64,0,63,255,254,133,10,80,96,0,0,8,1,6, + 18,4,24,0,63,128,0,0,4,64,0,0>>). + +test() -> + Bin1 = <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0, + 0,0,96,6,12,146,18,14,0,15,252,16,0,0,17,0,0>>, + Bin = <<Bin1/binary, Bin1/binary>>, + ?A = loop(Bin, 10, fun run_list/1), + ?A = loop(Bin, 10, fun run_bin/1), + ?B = loop(Bin, 10, fun r31/1), + ok. + +loop(Arg, 0, F) -> + F(Arg); +loop(Arg, N, F) -> + F(Arg), + loop(Arg, N-1, F). + +run_list(Bin) -> + List = run1(Bin), + list_to_binary(List). + +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2>>, run2(Rest)]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + [<<A1:2,A2:2,A3:2,0:2>>]; +run1(<<>>) -> + []. + +run_bin(Bin) -> + run2(Bin). + +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + Bin = run2(Rest), + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2,Bin/binary>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + <<A1:2,A2:2,A3:2,0:2>>; +run2(<<>>) -> + <<>>. + +r31(Bin) -> + List = remove3rd1(0, 0, Bin, [-1]), + build(List, Bin, 0, <<>>). + +build([N1, N2|Rest], Bin, N, Present) -> + X = N1+1, Y = N2-X, + S = rest(N2), + <<_:X,A:Y,_:S,_/binary>> = Bin, + S1 = rest(N+Y), + NewPresent = <<Present:N/binary-unit:1, A:Y, 0:S1>>, + build([N2|Rest], Bin, N+Y, NewPresent); + +build([_], _Bin, _N, Present) -> + Present. + +rest(X) -> + case 8 - (X rem 8) of + 8 -> 0; + H -> H + end. + +remove3rd1(N, 2, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, 0, Bin, [N|List]); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, 2, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end; +remove3rd1(N, I, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, I+1, Bin, List); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, I, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_save.erl b/lib/hipe/test/bs_SUITE_data/bs_save.erl new file mode 100644 index 0000000000..fe2b1105f2 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_save.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_save.erl +%%% Author : Per Gustafsson +%%% Purpose : Tests that compilation works for bs_save +%%% Created : 1 Nov 2007 +%%%------------------------------------------------------------------- +-module(bs_save). + +-export([test/0]). + +test() -> + {[16257, 1], <<0>>} = inc_on_ones(<<255,1,128,1,128,0>>, 0, [], 5), + ok. + +inc_on_ones(Buffer, _Av, Al, 0) -> + {lists:reverse(Al), Buffer}; +inc_on_ones(<<1:1, H:7, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, (Av bsl 7) bor H, Al, Len-1); +inc_on_ones(<<H, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, 0, [((Av bsl 7) bor H)|Al], Len-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl new file mode 100644 index 0000000000..b438f8d9ef --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl @@ -0,0 +1,275 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_shell_native.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests that the Erlang shell works well when in native +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_shell_native). + +-export([prepare_for_test/0, test/0]). +%% These need to be exported so that we emulate calling them from the shell +-export([parse_and_eval/1, receiver/1, receiver_alot/1, send_alot/3]). + +%% This makes sure the shell runs native code +prepare_for_test() -> + lists:foreach(fun (M) -> {ok, M} = hipe:c(M) end, [erl_bits, erl_eval]). + +test() -> + ok = eval_bits_in_shell(), + ok = eval_bin_comp_in_shell(), + ok. + +%%-------------------------------------------------------------------- +%% Tests for bit stream operations including matching, construction +%% and binary_to_list, list_to_binary in the shell +eval_bits_in_shell() -> + <<1:100>> = parse_and_eval("<<1:100>> = <<1:100>>."), + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = binary_to_and_from_list(), + ok = big_binary_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +parse_and_eval(String) -> + {ok, Toks, _} = erl_scan:string(String), + {ok, Exprs} = erl_parse:parse_exprs(Toks), + Bnds = erl_eval:new_bindings(), + case erl_eval:exprs(Exprs, Bnds) of + {value, V, _} -> + V; + V -> + V + end. + +match(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<0:N>> = <<0:N>>.", + <<0:N>> = parse_and_eval(Str), + ok. + +match1(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<42:N/little>> = <<42:N/little>>.", + <<42:N/little>> = parse_and_eval(Str), + ok. + +test_bitsize() -> + 101 = parse_and_eval("101 = erlang:bit_size(<<1:101>>)."), + 1001 = parse_and_eval("1001 = erlang:bit_size(<<1:1001>>)."), + 80 = parse_and_eval("80 = erlang:bit_size(<<1:80>>)."), + 800 = parse_and_eval("800 = erlang:bit_size(<<1:800>>)."), + S = + "Bin = <<0:16#1000000>>," + "BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)] ++ [<<1:1>>])," + "16#10000001 = erlang:bit_size(BigBin).", + 16#10000001 = parse_and_eval(S), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = erlang:bit_size(HugeBin), + 0 = parse_and_eval("0 = erlang:bit_size(<<>>)."), + ok. + +horrid_match() -> + S = "<<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, <<42:24/little>> = B.", + <<42:24/little>> = parse_and_eval(S), + ok. + +test_bitstr() -> + S = + "<<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>," + "<<1:1,6>> = B," + "B = <<1:1,6>>.", + <<1:1,6>> = parse_and_eval(S), + ok. + +asymmetric_tests() -> + <<1:12>> = parse_and_eval("<<1:12>> = <<0,1:4>>."), + <<0,1:4>> = parse_and_eval("<<0,1:4>> = <<1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X," + "X = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X1," + "X1 = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S2), + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = parse_and_eval("<<1:875,1:12>> = <<1:875,0,1:4>>."), + <<1:875,0,1:4>> = parse_and_eval("<<1:875,0,1:4>> = <<1:875,1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X," + "X = <<1,254,0,0:1,1:875>>.", + <<1,254,0,0:1,1:875>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X1," + "X1 = <<1,254,0,0:1,1:875>>.", + parse_and_eval(S2), + ok. + +binary_to_and_from_list() -> + <<1:7>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1:7>>))."), + <<1,2,3,4,1:1>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>))."), + [1,2,3,4,<<1:1>>] = parse_and_eval("bitstring_to_list(<<1,2,3,4,1:1>>)."), + <<1:1,1,2,3,4>> = parse_and_eval("list_to_bitstring([<<1:1>>,1,2,3,4])."), + [128,129,1,130,<<0:1>>] = parse_and_eval("bitstring_to_list(<<1:1,1,2,3,4>>)."), + ok. + +big_binary_to_and_from_list() -> + S1 = "erlang:list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)).", + <<1:800,2,3,4,1:1>> = parse_and_eval(S1), + S2 = "erlang:bitstring_to_list(<<1,2,3,4,1:800,1:1>>).", + [1,2,3,4|_Rest1] = parse_and_eval(S2), + S3 = "erlang:list_to_bitstring([<<1:801>>,1,2,3,4]).", + <<1:801,1,2,3,4>> = parse_and_eval(S3), + ok. + +send_and_receive() -> + S = + "Bin = <<1,2:7>>," + "Pid = spawn(fun() -> bs_shell_native:receiver(Bin) end)," + "Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}," + "receive ok -> ok end.", + parse_and_eval(S). + +receiver(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + S = + "Bin = <<1:1000001>>," + "Pid = spawn(fun() -> bs_shell_native:receiver_alot(Bin) end)," + "bs_shell_native:send_alot(100,Bin,Pid).", + parse_and_eval(S). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). + +%%-------------------------------------------------------------------- + +eval_bin_comp_in_shell() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>."), + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<"ABCDEFG">> = + parse_and_eval("<<\"ABCDEFG\">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>."), + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || X <- \"ABCDEFG\" >>."), + "abcdefg" = + parse_and_eval("\"abcdefg\" = [(X+32) || <<X>> <= <<\"ABCDEFG\">>]."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>]."), + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- \"ABCDEFG\" >>."), + "ABCDEFG" = + parse_and_eval("\"ABCDEFG\" = [(X-32) || <<X:7>> <= +<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>]."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>]."), + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]]."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]]."), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl new file mode 100644 index 0000000000..2e52308a77 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -0,0 +1,105 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- + +-module(bs_split). + +-export([test/0]). + +test() -> + Funs = [fun byte_split_binary/0, fun bit_split_binary/0, fun z_split/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%-------------------------------------------------------------------- + +byte_split_binary() -> + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, byte_size(B)). + +byte_split(L, B, Pos) when Pos >= 0 -> + Sz1 = Pos, + Sz2 = byte_size(B) - Pos, + bs1(L, B, Pos, Sz1, Sz2); +byte_split(_, _, _) -> ok. + +bs1(L, B, Pos, Sz1, Sz2) -> + <<B1:Sz1/binary, B2:Sz2/binary>> = B, + bs2(L, B, Pos, B1, B2). + +bs2(L, B, Pos, B1, B2)-> + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + bs3(L, B, Pos, B2). + +bs3(L, B, Pos, B2) -> + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos-1). + +%%-------------------------------------------------------------------- + +bit_split_binary() -> + Fun = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + %% io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) + end, + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)). + +bit_split_binary1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + bit_split_binary2(Action, Bin, BitList, 0). + +bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> + bit_split_binary3(Action, Bin, List, Bef, bit_size(Bin)), + bit_split_binary2(Action, Bin, T, Bef+1); +bit_split_binary2(_Action, _Bin, [], _Bef) -> 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(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([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +%%-------------------------------------------------------------------- +%% Splits a series of null terminated segments of a binary without +%% creating any new sub-binaries until the zero is found. + +z_split() -> + [<<61,62,63>>] = z_split(<<61,62,63>>), + [<<61,62,63>>, <<>>] = z_split(<<61,62,63,0>>), + [<<61,62,63>>, <<64>>] = z_split(<<61,62,63,0,64>>), + [<<61,62,63>>, <<64,65,66>>] = z_split(<<61,62,63,0,64,65,66>>), + [<<61,62>>, <<64>>, <<>>, <<65,66>>] = z_split(<<61,62,0,64,0,0,65,66>>), + ok. + +z_split(B) when is_binary(B) -> + z_split(B, 0). + +z_split(B, N) -> + case B of + <<_B1:N/binary,0,_B2/binary>> -> % use skip_bits for B1, B2 + <<B1:N/binary,_,B2/binary>> = B, % and postpone the matching + [B1 | z_split(B2)]; + <<_:N/binary>> -> + [B]; + _ -> + z_split(B, N+1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl new file mode 100644 index 0000000000..eccb0083bd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_system_limit_32.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks binary system limits on 32-bit machines +%%% Created : 14 May 2008 +%%%------------------------------------------------------------------- +-module(bs_system_limit_32). + +-export([test/0]). + +test() -> + case erlang:system_info(wordsize) of + 4 -> system_limit_32(); + 8 -> ok + end. + +system_limit_32() -> + {'EXIT', {badarg, _}} = (catch <<42:(id(-1))>>), + {'EXIT', {badarg, _}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<32:536870912/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8,1:1>>), + ok. + +id(X) -> X. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl new file mode 100644 index 0000000000..f50ae08964 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -0,0 +1,18 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%%------------------------------------------------------------------- + +-module(bs_utf). + +-export([test/0]). + +test() -> + <<65>> = b65utf8(), + ok = m(<<65>>). + +m(<<65/utf8>>) -> + ok. + +b65utf8() -> + <<65/utf8>>. diff --git a/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl new file mode 100644 index 0000000000..a20df04b53 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl @@ -0,0 +1,76 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Author : Kostis Sagonas +%% Purpose : These tests are intended to test the construction and +%% matching of binaries using variable sizes +%% Notes : +%% - Added test that crashed BEAM compiler +%% - Added test that crashed when segments of size zero were used +%% and one that did not convert integers to floats when constructing +%% binaries. +%% - Added a construction test which crashed from core because of +%% problems with the effect flag (2004/11/15) +%%-------------------------------------------------------------------- +-module(bs_var_segs). + +-export([test/0]). + +test() -> + N1 = 18, + A1 = 2, + A1 = match1(N1, <<1:12, 2:N1, A1:2>>), + A1 = match2(N1, <<1:12, 2:N1/integer-little, A1:2>>), + N3 = 3, + A3 = <<1,2,3>>, + B3 = 2, + {A3, B3} = match3(N3, <<1:12, A3:N3/binary, B3:4>>), + N4 = 12, + B4 = <<1,2,3>>, + A4 = 2, + {A4, B4} = match4(N4, <<1:N4, A4:4, B4/binary>>), + Y = <<5>>, + Y = match5(a, Y), + <<73>> = gen1(8, 0, <<73>>), + <<171>> = gen2(8, 7, 2#10101010101010101), + <<0:64>> = construct(), + <<0:32>> = construct2(0), + ok = in_guard(<<16#BCD:14,3:2>>, 16#BCD), + ok. + +construct() -> + <<0:64/float>>. + +construct2(X) -> + <<X:32/little>>. + +match1(N, Bin) -> + <<1:12, 2:N, A:2>>=Bin, + A. + +match2(N, Bin) -> + <<1:12, 2:N/integer-little, A:2>>=Bin, + A. + +match3(N, Bin) -> + <<1:12, A:N/binary, B:4>>=Bin, + {A,B}. + +match4(N, Bin) -> + <<1:N, A:4, B/binary>>=Bin, + {A,B}. + +match5(X, Y) -> + case X of + a -> + Y2 = 8 + end, + <<5:Y2>> = Y. + +gen1(N, S, A) -> + <<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>. + +gen2(N, S, A) -> + <<A:S/little, A:(N-S)/little>>. + +in_guard(Bin, A) when <<A:14,3:2>> == Bin -> ok; +in_guard(_, _) -> no. diff --git a/lib/hipe/test/hipe.spec b/lib/hipe/test/hipe.spec index 6b0b226dc3..2894f40354 100644 --- a/lib/hipe/test/hipe.spec +++ b/lib/hipe/test/hipe.spec @@ -1 +1,6 @@ -{suites,"../hipe_test",all}. +%% -*- erlang -*- + +{alias, tests, "../hipe_test"}. + +{suites, tests, all}. + diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl new file mode 100644 index 0000000000..c8fdf1600c --- /dev/null +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -0,0 +1,182 @@ +-module(hipe_testsuite_driver). + +-export([create_all_suites/0, run/3]). + +-include_lib("kernel/include/file.hrl"). + +-type testcase() :: atom(). +-type file_type() :: 'device' | 'directory' | 'regular' | 'other'. +-type ext_posix() :: file:posix() | 'badarg'. + +-define(suite_suffix, "_SUITE"). +-define(data_folder, "_data"). +-define(suite_data, ?suite_suffix ++ ?data_folder). + +-record(suite, {suitename :: string(), + outputfile :: file:io_device(), + testcases :: [testcase()]}). + +-spec create_all_suites() -> 'ok'. + +create_all_suites() -> + {ok, Cwd} = file:get_cwd(), + Suites = get_suites(Cwd), + lists:foreach(fun create_suite/1, Suites). + +-spec get_suites(file:filename()) -> [string()]. + +get_suites(Dir) -> + case file:list_dir(Dir) of + {error, _} -> []; + {ok, Filenames} -> + FullFilenames = [filename:join(Dir, F) || F <- Filenames], + Dirs = [suffix(filename:basename(F), ?suite_data) || + F <- FullFilenames, + file_type(F) =:= {ok, 'directory'}], + [S || {yes, S} <- Dirs] + end. + +suffix(String, Suffix) -> + case string:rstr(String, Suffix) of + 0 -> no; + Index -> + case string:substr(String, Index) =:= Suffix of + true -> {yes, string:sub_string(String, 1, Index-1)}; + false -> no + end + end. + +-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}. + +file_type(Filename) -> + case file:read_file_info(Filename) of + {ok, FI} -> {ok, FI#file_info.type}; + Error -> Error + end. + +-spec create_suite(string()) -> 'ok'. + +create_suite(SuiteName) -> + {ok, Cwd} = file:get_cwd(), + SuiteDirN = filename:join(Cwd, SuiteName ++ ?suite_data), + OutputFile = generate_suite_file(Cwd, SuiteName), + generate_suite(SuiteName, OutputFile, SuiteDirN). + +generate_suite_file(Cwd, SuiteName) -> + F = filename:join(Cwd, SuiteName ++ ?suite_suffix ++ ".erl"), + case file:open(F, [write]) of + {ok, IoDevice} -> IoDevice; + {error, _} = E -> exit({E, F}) + end. + +generate_suite(SuiteName, OutputFile, SuiteDirN) -> + TestCases = list_testcases(SuiteDirN), + Suite = #suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}, + write_suite(Suite), + file:close(OutputFile). + +list_testcases(Dirname) -> + {ok, Files} = list_dir(Dirname, ".erl", true), + [list_to_atom(filename:basename(F, ".erl")) || F <- Files]. + +-spec list_dir(file:filename(), string(), boolean()) -> + {error, ext_posix()} | {ok, [file:filename()]}. + +list_dir(Dir, Extension, Dirs) -> + case file:list_dir(Dir) of + {error, _} = Error-> Error; + {ok, Filenames} -> + FullFilenames = [filename:join(Dir, F) || F <- Filenames], + Matches1 = case Dirs of + true -> + [F || F <- FullFilenames, + file_type(F) =:= {ok, 'directory'}]; + false -> [] + end, + Matches2 = [F || F <- FullFilenames, + file_type(F) =:= {ok, 'regular'}, + filename:extension(F) =:= Extension], + {ok, lists:sort(Matches1 ++ Matches2)} + end. + +write_suite(Suite) -> + write_header(Suite), + write_testcases(Suite). + +write_header(#suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}) -> + Exports = format_export(TestCases), + TimeLimit = 2, %% with 1 it fails on some slow machines... + io:format(OutputFile, + "%% ATTENTION!\n" + "%% This is an automatically generated file. Do not edit.\n\n" + "-module(~s).\n\n" + "-export([suite/0, init_per_suite/0, init_per_suite/1,\n" + " end_per_suite/1, all/0]).\n" + "~s\n\n" + "-include_lib(\"common_test/include/ct.hrl\").\n\n" + "suite() ->\n" + " [{timetrap, {minutes, ~w}}].\n\n" + "init_per_suite() ->\n" + " [].\n\n" + "init_per_suite(Config) ->\n" + " case erlang:system_info(hipe_architecture) of\n" + " undefined -> {skip, \"HiPE not available or enabled\"};\n" + " _ -> Config\n" + " end.\n\n" + "end_per_suite(_Config) ->\n" + " ok.\n\n" + "all() ->\n" + " ~p.\n\n" + "test(Config, TestCase) ->\n" + " Dir = ?config(data_dir, Config),\n" + " OutDir = ?config(priv_dir, Config),\n" + " hipe_testsuite_driver:run(TestCase, Dir, OutDir)." + "\n\n", + [SuiteName ++ ?suite_suffix, Exports, TimeLimit, TestCases]). + +format_export(TestCases) -> + TL = [list_to_atom(atom_to_list(N)++"/1") || N <- TestCases], + TestCaseString = io_lib:format("-export(~p).", [TL]), + strip_quotes(lists:flatten(TestCaseString), []). + +strip_quotes([], Result) -> + lists:reverse(Result); +strip_quotes([$' |Rest], Result) -> + strip_quotes(Rest, Result); +strip_quotes([$\, |Rest], Result) -> + strip_quotes(Rest, [$\ , $\, |Result]); +strip_quotes([C|Rest], Result) -> + strip_quotes(Rest, [C|Result]). + +write_testcases(#suite{outputfile = OutputFile, testcases = TestCases}) -> + lists:foreach(fun (T) -> write_testcase(OutputFile, T) end, TestCases). + +write_testcase(OutputFile, TestCase) -> + io:format(OutputFile, + "~p(Config) ->\n" + " test(Config, ~p).\n\n", + [TestCase, TestCase]). + +-spec run(atom(), string(), string()) -> 'ok'. + +run(TestCase, Dir, _OutDir) -> + F = filename:join(Dir, atom_to_list(TestCase) ++ ".erl"), + {ok, TestCase} = compile:file(F), + ok = try TestCase:prepare_for_test() catch _:_ -> ok end, + %% DataFiles = try TestCase:datafiles() catch _:_ -> [] end, + %% lists:foreach(fun (DF) -> + %% Src = filename:join(Dir, DF), + %% Dst = filename:join(OutDir, DF), + %% {ok, _} = file:copy(Src, Dst) + %% end, DataFiles), + %% try + ok = TestCase:test(), + HiPEOpts = try TestCase:hipe_options() catch _:_ -> [] end, + {ok, TestCase} = hipe:c(TestCase, HiPEOpts), + ok = TestCase:test(). + %% after + %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, + %% [filename:join(OutDir, D) || D <- DataFiles]) + %% end. |