%% -*- 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).