aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe')
-rw-r--r--lib/hipe/cerl/cerl_closurean.erl8
-rw-r--r--lib/hipe/cerl/cerl_messagean.erl4
-rw-r--r--lib/hipe/cerl/cerl_typean.erl4
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl3
-rw-r--r--lib/hipe/cerl/erl_types.erl156
-rw-r--r--lib/hipe/flow/cfg.hrl6
-rw-r--r--lib/hipe/flow/cfg.inc4
-rw-r--r--lib/hipe/flow/hipe_dominators.erl6
-rw-r--r--lib/hipe/flow/liveness.inc6
-rw-r--r--lib/hipe/icode/hipe_icode_callgraph.erl4
-rw-r--r--lib/hipe/icode/hipe_icode_cfg.erl6
-rw-r--r--lib/hipe/icode/hipe_icode_coordinator.erl8
-rw-r--r--lib/hipe/icode/hipe_icode_exceptions.erl8
-rw-r--r--lib/hipe/icode/hipe_icode_fp.erl6
-rw-r--r--lib/hipe/icode/hipe_icode_instruction_counter.erl5
-rw-r--r--lib/hipe/icode/hipe_icode_range.erl10
-rw-r--r--lib/hipe/icode/hipe_icode_ssa.erl4
-rw-r--r--lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl16
-rw-r--r--lib/hipe/icode/hipe_icode_type.erl6
-rw-r--r--lib/hipe/main/hipe.app.src1
-rw-r--r--lib/hipe/main/hipe.appup.src7
-rw-r--r--lib/hipe/misc/hipe_consttab.erl8
-rw-r--r--lib/hipe/misc/hipe_consttab.hrl4
-rw-r--r--lib/hipe/misc/hipe_pack_constants.erl4
-rw-r--r--lib/hipe/misc/hipe_sdi.erl15
-rw-r--r--lib/hipe/regalloc/hipe_ig_moves.erl4
-rw-r--r--lib/hipe/ssa/hipe_ssa_const_prop.inc10
-rw-r--r--lib/hipe/test/Makefile73
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_add.erl18
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bincomp.erl79
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bits.erl150
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bitsize.erl23
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl32
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl35
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl133
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_build.erl41
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl25
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_checksum.erl35
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_construct.erl128
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_decode.erl980
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl91
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_des.erl734
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_extract.erl94
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_flatb.erl29
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_id3.erl75
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_match.erl175
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_native_float.erl22
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_orber.erl26
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_pmatch.erl269
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl67
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl23
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_potpurri.erl200
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_remove3.erl104
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_save.erl21
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_shell_native.erl275
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_split.erl105
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl26
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_utf.erl18
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_var_segs.erl76
-rw-r--r--lib/hipe/test/hipe.spec6
-rw-r--r--lib/hipe/test/hipe_SUITE.erl55
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl182
-rw-r--r--lib/hipe/util/hipe_digraph.erl8
-rw-r--r--lib/hipe/util/hipe_dot.erl6
-rw-r--r--lib/hipe/util/hipe_vectors.hrl4
65 files changed, 4609 insertions, 157 deletions
diff --git a/lib/hipe/cerl/cerl_closurean.erl b/lib/hipe/cerl/cerl_closurean.erl
index 021acd5b35..1b325703ae 100644
--- a/lib/hipe/cerl/cerl_closurean.erl
+++ b/lib/hipe/cerl/cerl_closurean.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -78,7 +78,8 @@
%% function; see `analyze' for details.
-spec annotate(cerl:cerl()) ->
- {cerl:cerl(), outlist(), dict(), escapes(), dict(), dict()}.
+ {cerl:cerl(), outlist(), dict:dict(),
+ escapes(), dict:dict(), dict:dict()}.
annotate(Tree) ->
{Xs, Out, Esc, Deps, Par} = analyze(Tree),
@@ -206,7 +207,8 @@ append_ann(Tag, Val, []) ->
%% variable labeled `escape', which will hold the set of escaped labels.
%% initially it contains `top' and `external'.
--spec analyze(cerl:cerl()) -> {outlist(), dict(), escapes(), dict(), dict()}.
+-spec analyze(cerl:cerl()) ->
+ {outlist(), dict:dict(), escapes(), dict:dict(), dict:dict()}.
analyze(Tree) ->
%% Note that we use different name spaces for variable labels and
diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl
index ca812a0f0d..7911b875a9 100644
--- a/lib/hipe/cerl/cerl_messagean.erl
+++ b/lib/hipe/cerl/cerl_messagean.erl
@@ -1,7 +1,7 @@
%% =====================================================================
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -182,7 +182,7 @@
-type label() :: integer() | 'external' | 'top'.
-type ordset(X) :: [X]. % XXX: TAKE ME OUT
--spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict()}.
+-spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict:dict()}.
annotate(Tree) ->
{Esc0, Vars} = analyze(Tree),
diff --git a/lib/hipe/cerl/cerl_typean.erl b/lib/hipe/cerl/cerl_typean.erl
index ccd8903658..f694c07c82 100644
--- a/lib/hipe/cerl/cerl_typean.erl
+++ b/lib/hipe/cerl/cerl_typean.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -242,7 +242,7 @@ delete_ann(_, []) ->
-type labelset() :: ordset(label()).
-type outlist() :: [labelset()] | 'none'.
--spec analyze(cerl:cerl()) -> {outlist(), dict(), dict()}.
+-spec analyze(cerl:cerl()) -> {outlist(), dict:dict(), dict:dict()}.
analyze(Tree) ->
analyze(Tree, ?DEF_LIMIT).
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 8b610ac893..0512d4bc3c 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -912,7 +912,8 @@ type(erlang, system_info, 1, Xs, Opaques) ->
t_list(t_pid());
['os_type'] ->
t_tuple([t_sup([t_atom('unix'),
- t_atom('win32')]),
+ t_atom('win32'),
+ t_atom('ose')]),
t_atom()]);
['os_version'] ->
t_sup(t_tuple([t_non_neg_fixnum(),
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 329a71b099..32390045e3 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -228,7 +228,7 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0]).
+-export_type([erl_type/0, type_table/0, var_table/0]).
%%-define(DEBUG, true).
@@ -363,6 +363,15 @@
-type opaques() :: [erl_type()] | 'universe'.
+-type record_key() :: {'record', atom()}.
+-type type_key() :: {'type' | 'opaque', atom(), arity()}.
+-type record_value() :: orddict:orddict(). % XXX. To be refined
+-type type_value() :: {module(), erl_type(), atom()}.
+-type type_table() :: dict:dict(record_key(), record_value())
+ | dict:dict(type_key(), type_value()).
+
+-type var_table() :: dict:dict(atom(), erl_type()).
+
%%-----------------------------------------------------------------------------
%% Unions
%%
@@ -723,7 +732,7 @@ decorate_tuples_in_sets([T1|Tuples], L2, Opaques, Acc) ->
decorate_tuples_in_sets([], _L, _Opaques, Acc) ->
lists:reverse(Acc).
--spec t_opaque_from_records(dict()) -> [erl_type()].
+-spec t_opaque_from_records(type_table()) -> [erl_type()].
t_opaque_from_records(RecDict) ->
OpaqueRecDict =
@@ -798,7 +807,9 @@ t_is_remote(Type) ->
is_remote(?remote(_)) -> true;
is_remote(_) -> false.
--spec t_solve_remote(erl_type(), set(), dict()) -> erl_type().
+-type mod_records() :: dict:dict(module(), type_table()).
+
+-spec t_solve_remote(erl_type(), sets:set(mfa()), mod_records()) -> erl_type().
t_solve_remote(Type, ExpTypes, Records) ->
{RT, _RR} = t_solve_remote(Type, ExpTypes, Records, []),
@@ -1962,7 +1973,7 @@ t_timeout() ->
-spec t_array() -> erl_type().
t_array() ->
- t_opaque(array, array, [],
+ t_opaque(array, array, [t_any()],
t_tuple([t_atom('array'),
t_sup([t_atom('undefined'), t_non_neg_integer()]),
t_sup([t_atom('undefined'), t_non_neg_integer()]),
@@ -1972,7 +1983,7 @@ t_array() ->
-spec t_dict() -> erl_type().
t_dict() ->
- t_opaque(dict, dict, [],
+ t_opaque(dict, dict, [t_any(), t_any()],
t_tuple([t_atom('dict'),
t_sup([t_atom('undefined'), t_non_neg_integer()]),
t_sup([t_atom('undefined'), t_non_neg_integer()]),
@@ -2008,12 +2019,12 @@ t_gb_tree() ->
-spec t_queue() -> erl_type().
t_queue() ->
- t_opaque(queue, queue, [], t_tuple([t_list(), t_list()])).
+ t_opaque(queue, queue, [t_any()], t_tuple([t_list(), t_list()])).
-spec t_set() -> erl_type().
t_set() ->
- t_opaque(sets, set, [],
+ t_opaque(sets, set, [t_any()],
t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(),
t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(),
t_non_neg_integer(),
@@ -2031,18 +2042,6 @@ all_opaque_builtins() ->
[t_array(), t_dict(), t_digraph(), t_gb_set(),
t_gb_tree(), t_queue(), t_set(), t_tid()].
--spec is_opaque_builtin(atom(), atom()) -> boolean().
-
-is_opaque_builtin(array, array) -> true;
-is_opaque_builtin(dict, dict) -> true;
-is_opaque_builtin(digraph, digraph) -> true;
-is_opaque_builtin(gb_sets, gb_set) -> true;
-is_opaque_builtin(gb_trees, gb_tree) -> true;
-is_opaque_builtin(queue, queue) -> true;
-is_opaque_builtin(sets, set) -> true;
-is_opaque_builtin(ets, tid) -> true;
-is_opaque_builtin(_, _) -> false.
-
%%------------------------------------
%% ?none is allowed in products. A product of size 1 is not a product.
@@ -2831,9 +2830,9 @@ comb(Mod, Name, Args, S, T) ->
false -> T#opaque{struct = S}
end.
-is_same_name(Mod, Name, Args,
- ?opaque([#opaque{mod = Mod, name = Name, args = Args}])) ->
- true;
+is_same_name(Mod1, Name1, Args1,
+ ?opaque([#opaque{mod = Mod2, name = Name2, args = Args2}])) ->
+ is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2});
is_same_name(_, _, _, _) -> false.
%% Combining two lists this way can be very time consuming...
@@ -3035,13 +3034,13 @@ findfirst(N1, N2, U1, B1, U2, B2) ->
%% to types. Hans Bolinder suggested the use of lists of Key-Value pairs for
%% this data structure and measurements showed a non-trivial speedup when using
%% them for operations within this module (e.g. in t_unify/2). However, there
-%% is code outside erl_types that still passes a dict() in the 2nd argument.
+%% is code outside erl_types that still passes a dict:dict() in the 2nd argument.
%% So, for the time being, this module provides a t_subst/2 function for these
%% external calls and a clone of it (t_subst_kv/2) which is used from all calls
%% from within this module. This code duplication needs to be eliminated at
%% some point.
--spec t_subst(erl_type(), dict()) -> erl_type().
+-spec t_subst(erl_type(), dict:dict(atom(), erl_type())) -> erl_type().
t_subst(T, Dict) ->
case t_has_var(T) of
@@ -3785,7 +3784,7 @@ t_limit_k(T, _K) -> T.
%%
%%============================================================================
--spec t_abstract_records(erl_type(), dict()) -> erl_type().
+-spec t_abstract_records(erl_type(), type_table()) -> erl_type().
t_abstract_records(?list(Contents, Termination, Size), RecDict) ->
case t_abstract_records(Contents, RecDict) of
@@ -3865,7 +3864,7 @@ t_map(Fun, T) ->
t_to_string(T) ->
t_to_string(T, dict:new()).
--spec t_to_string(erl_type(), dict()) -> string().
+-spec t_to_string(erl_type(), type_table()) -> string().
t_to_string(?any, _RecDict) ->
"any()";
@@ -4051,7 +4050,7 @@ record_fields_to_string([F|Fs], [{FName, _DefType}|FDefs], RecDict, Acc) ->
record_fields_to_string([], [], _RecDict, Acc) ->
lists:reverse(Acc).
--spec record_field_diffs_to_string(erl_type(), dict()) -> string().
+-spec record_field_diffs_to_string(erl_type(), type_table()) -> string().
record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) ->
[TagAtom] = atom_vals(Tag),
@@ -4086,9 +4085,9 @@ union_sequence(Types, RecDict) ->
-ifdef(DEBUG).
opaque_type(Mod, Name, _Args, S, RecDict) ->
- ArgsString = "[ARGS:" ++ comma_sequence(_Args, RecDict) ++ "]",
+ ArgsString = comma_sequence(_Args, RecDict),
String = t_to_string(S, RecDict),
- opaque_name(Mod, Name, ArgsString ++ String).
+ opaque_name(Mod, Name, ArgsString) ++ "[" ++ String ++ "]".
-else.
opaque_type(Mod, Name, Args, _S, RecDict) ->
ArgsString = comma_sequence(Args, RecDict),
@@ -4100,11 +4099,16 @@ opaque_name(Mod, Name, Extra) ->
flat_format("~s(~s)", [S, Extra]).
mod_name(Mod, Name) ->
- case is_opaque_builtin(Mod, Name) of
+ case is_obsolete_opaque_builtin(Mod, Name) of
true -> flat_format("~w", [Name]);
false -> flat_format("~w:~w", [Mod, Name])
end.
+is_obsolete_opaque_builtin(digraph, digraph) -> true;
+is_obsolete_opaque_builtin(gb_sets, gb_set) -> true;
+is_obsolete_opaque_builtin(gb_trees, gb_tree) -> true;
+is_obsolete_opaque_builtin(_, _) -> false.
+
%%=============================================================================
%%
%% Build a type from parse forms.
@@ -4116,19 +4120,20 @@ mod_name(Mod, Name) ->
t_from_form(Form) ->
t_from_form(Form, dict:new()).
--spec t_from_form(parse_form(), dict()) -> erl_type().
+-spec t_from_form(parse_form(), type_table()) -> erl_type().
t_from_form(Form, RecDict) ->
t_from_form(Form, RecDict, dict:new()).
--spec t_from_form(parse_form(), dict(), dict()) -> erl_type().
+-spec t_from_form(parse_form(), type_table(), var_table()) -> erl_type().
t_from_form(Form, RecDict, VarDict) ->
{T, _R} = t_from_form(Form, [], RecDict, VarDict),
T.
--type type_names() :: [{'type' | 'opaque' | 'record', atom()}].
--spec t_from_form(parse_form(), type_names(), dict(), dict()) ->
+-type type_names() :: [type_key() | record_key()].
+
+-spec t_from_form(parse_form(), type_names(), type_table(), var_table()) ->
{erl_type(), type_names()}.
t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) ->
@@ -4167,8 +4172,8 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) ->
{t_any(), []};
t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) ->
{t_arity(), []};
-t_from_form({type, _L, array, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_array(), []};
+t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(array, t_array(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) ->
{t_atom(), []};
t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4190,10 +4195,10 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) ->
{t_byte(), []};
t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) ->
{t_char(), []};
-t_from_form({type, _L, dict, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_dict(), []};
-t_from_form({type, _L, digraph, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_digraph(), []};
+t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict);
+t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) ->
{t_float(), []};
t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4209,10 +4214,10 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
{L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict),
{T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict),
{t_fun(L, T), R1 ++ R2};
-t_from_form({type, _L, gb_set, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_gb_set(), []};
-t_from_form({type, _L, gb_tree, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_gb_tree(), []};
+t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict);
+t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) ->
{t_identifier(), []};
t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4285,8 +4290,8 @@ t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) ->
{L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict),
{t_product(L), R};
-t_from_form({type, _L, queue, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_queue(), []};
+t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, range, [From, To]} = Type,
_TypeNames, _RecDict, _VarDict) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
@@ -4298,14 +4303,14 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) ->
record_from_form(Name, Fields, TypeNames, RecDict, VarDict);
t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) ->
{t_reference(), []};
-t_from_form({type, _L, set, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_set(), []};
+t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(set, t_set(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) ->
{t_string(), []};
t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) ->
{t_any(), []};
-t_from_form({type, _L, tid, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_tid(), []};
+t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) ->
+ builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) ->
{t_timeout(), []};
t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) ->
@@ -4322,36 +4327,46 @@ t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames,
_RecDict, _VarDict) ->
{t_opaque(Mod, Name, Args, Rep), []}.
+builtin_type(Name, Type, TypeNames, RecDict, VarDict) ->
+ case lookup_type(Name, 0, RecDict) of
+ {_, {_M, _T, _A}} ->
+ type_from_form(Name, [], TypeNames, RecDict, VarDict);
+ error ->
+ {Type, []}
+ end.
+
type_from_form(Name, Args, TypeNames, RecDict, VarDict) ->
ArgsLen = length(Args),
ArgTypes = forms_to_types(Args, TypeNames, RecDict, VarDict),
case lookup_type(Name, ArgsLen, RecDict) of
{type, {_Module, Type, ArgNames}} ->
- case can_unfold_more({type, Name}, TypeNames) of
+ TypeName = {type, Name, ArgsLen},
+ case can_unfold_more(TypeName, TypeNames) of
true ->
List = lists:zip(ArgNames, ArgTypes),
TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [{type, Name}|TypeNames],
+ {T, R} = t_from_form(Type, [TypeName|TypeNames],
RecDict, TmpVarDict),
- case lists:member({type, Name}, R) of
+ case lists:member(TypeName, R) of
true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
false -> {T, R}
end;
- false -> {t_any(), [{type, Name}]}
+ false -> {t_any(), [TypeName]}
end;
{opaque, {Module, Type, ArgNames}} ->
+ TypeName = {opaque, Name, ArgsLen},
{Rep, Rret} =
- case can_unfold_more({opaque, Name}, TypeNames) of
+ case can_unfold_more(TypeName, TypeNames) of
true ->
List = lists:zip(ArgNames, ArgTypes),
TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames],
+ {T, R} = t_from_form(Type, [TypeName|TypeNames],
RecDict, TmpVarDict),
- case lists:member({opaque, Name}, R) of
+ case lists:member(TypeName, R) of
true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
false -> {T, R}
end;
- false -> {t_any(), [{opaque, Name}]}
+ false -> {t_any(), [TypeName]}
end,
Args2 = [subst_all_vars_to_any(ArgType) || ArgType <- ArgTypes],
{skip_opaque_alias(Rep, Module, Name, Args2), Rret};
@@ -4588,7 +4603,7 @@ is_erl_type(?unit) -> true;
is_erl_type(#c{}) -> true;
is_erl_type(_) -> false.
--spec lookup_record(atom(), dict()) ->
+-spec lookup_record(atom(), type_table()) ->
'error' | {'ok', [{atom(), parse_form() | erl_type()}]}.
lookup_record(Tag, RecDict) when is_atom(Tag) ->
@@ -4603,7 +4618,8 @@ lookup_record(Tag, RecDict) when is_atom(Tag) ->
error
end.
--spec lookup_record(atom(), arity(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}.
+-spec lookup_record(atom(), arity(), type_table()) ->
+ 'error' | {'ok', [{atom(), erl_type()}]}.
lookup_record(Tag, Arity, RecDict) when is_atom(Tag) ->
case dict:find({record, Tag}, RecDict) of
@@ -4622,7 +4638,8 @@ lookup_type(Name, Arity, RecDict) ->
{ok, Found} -> {type, Found}
end.
--spec type_is_defined('type' | 'opaque', atom(), arity(), dict()) -> boolean().
+-spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) ->
+ boolean().
type_is_defined(TypeOrOpaque, Name, Arity, RecDict) ->
dict:is_key({TypeOrOpaque, Name, Arity}, RecDict).
@@ -4654,10 +4671,17 @@ do_opaque(?union(List) = Type, Opaques, Pred) ->
do_opaque(Type, _Opaques, Pred) ->
Pred(Type).
-is_same_type_name({Mod, Name, Args}, {Mod, Name, Args}) -> true;
+is_same_type_name(ModNameArgs, ModNameArgs) -> true;
+is_same_type_name({Mod, Name, Args1}, {Mod, Name, Args2}) ->
+ all_any(Args1) orelse all_any(Args2);
is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) ->
is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2).
+all_any([]) -> true;
+all_any([T|L]) ->
+ t_is_any(T) andalso all_any(L);
+all_any(_) -> false.
+
%% Compatibility. In Erlang/OTP 17 the pre-defined opaque types
%% digraph() and so on can be used, but there are also new types such
%% as digraph:graph() with the exact same meaning. In Erlang/OTP R18.0
@@ -4665,10 +4689,10 @@ is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) ->
is_same_type_name2(digraph, digraph, [], digraph, graph, []) -> true;
is_same_type_name2(digraph, graph, [], digraph, digraph, []) -> true;
-is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [?any]) -> true;
-is_same_type_name2(gb_sets, set, [?any], gb_sets, gb_set, []) -> true;
-is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [?any, ?any]) -> true;
-is_same_type_name2(gb_trees, tree, [?any, ?any], gb_trees, gb_tree, []) -> true;
+is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [_]) -> true;
+is_same_type_name2(gb_sets, set, [_], gb_sets, gb_set, []) -> true;
+is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true;
+is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true;
is_same_type_name2(_, _, _, _, _, _) -> false.
%% -----------------------------------
diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl
index 95bf5f7194..1f7a162f27 100644
--- a/lib/hipe/flow/cfg.hrl
+++ b/lib/hipe/flow/cfg.hrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -42,12 +42,12 @@
%%
%% Data is a triple with a dict of constants, a list of labels and an integer
%%
--type cfg_data() :: {dict(), [cfg_lbl()], non_neg_integer()}.
+-type cfg_data() :: {dict:dict(), [cfg_lbl()], non_neg_integer()}.
%%
%% The following is to be used by other modules
%%
--record(cfg, {table = gb_trees:empty() :: gb_tree(),
+-record(cfg, {table = gb_trees:empty() :: gb_trees:tree(),
info :: #cfg_info{},
data :: cfg_data()}).
-type cfg() :: #cfg{}.
diff --git a/lib/hipe/flow/cfg.inc b/lib/hipe/flow/cfg.inc
index 62f399a81c..f0b1a75737 100644
--- a/lib/hipe/flow/cfg.inc
+++ b/lib/hipe/flow/cfg.inc
@@ -4,7 +4,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -534,7 +534,7 @@ breadth_list([], Vis, _CFG, BO) ->
{Vis, BO}.
-endif.
--spec none_visited() -> gb_set().
+-spec none_visited() -> gb_sets:set().
none_visited() ->
gb_sets:empty().
diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl
index 113a32c3b7..50d45c7c72 100644
--- a/lib/hipe/flow/hipe_dominators.erl
+++ b/lib/hipe/flow/hipe_dominators.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -57,7 +57,7 @@
-record(domTree, {root :: cfg_lbl(),
size = 0 :: non_neg_integer(),
- nodes = gb_trees:empty() :: gb_tree()}).
+ nodes = gb_trees:empty() :: gb_trees:tree()}).
-type domTree() :: #domTree{}.
%%>----------------------------------------------------------------------<
@@ -590,7 +590,7 @@ domTree_pp_children([], _) ->
%%
%%========================================================================
--type domFrontier() :: gb_tree().
+-type domFrontier() :: gb_trees:tree().
%%>----------------------------------------------------------------------<
%% Procedure : domFrontier_create
diff --git a/lib/hipe/flow/liveness.inc b/lib/hipe/flow/liveness.inc
index 9c5eaf3e68..6f161fb269 100644
--- a/lib/hipe/flow/liveness.inc
+++ b/lib/hipe/flow/liveness.inc
@@ -3,7 +3,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -71,7 +71,7 @@
%% The generic liveness analysis
%%
--spec analyze(cfg()) -> gb_tree().
+-spec analyze(cfg()) -> gb_trees:tree().
-ifdef(HIPE_LIVENESS_CALC_LARGEST_LIVESET).
analyze(CFG) ->
@@ -209,7 +209,7 @@ successors(L, Liveness) ->
{_GK, _LiveIn, Successors} = liveness_lookup(L, Liveness),
Successors.
--spec livein(gb_tree(), _) -> [_].
+-spec livein(gb_trees:tree(), _) -> [_].
livein(Liveness, L) ->
{_GK, LiveIn, _Successors} = liveness_lookup(L, Liveness),
diff --git a/lib/hipe/icode/hipe_icode_callgraph.erl b/lib/hipe/icode/hipe_icode_callgraph.erl
index 5789328f47..ccf97ecc17 100644
--- a/lib/hipe/icode/hipe_icode_callgraph.erl
+++ b/lib/hipe/icode/hipe_icode_callgraph.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -46,7 +46,7 @@
-type mfa_icode() :: {mfa(), #icode{}}.
--record(icode_callgraph, {codedict :: dict(), ordered_sccs :: [[mfa()]]}).
+-record(icode_callgraph, {codedict :: dict:dict(), ordered_sccs :: [[mfa()]]}).
%%------------------------------------------------------------------------
%% Exported functions
diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl
index 9b4a10e273..f6c2b0600b 100644
--- a/lib/hipe/icode/hipe_icode_cfg.erl
+++ b/lib/hipe/icode/hipe_icode_cfg.erl
@@ -3,7 +3,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -54,8 +54,8 @@
-spec postorder(cfg()) -> [icode_lbl()].
-spec reverse_postorder(cfg()) -> [icode_lbl()].
--spec is_visited(icode_lbl(), gb_set()) -> boolean().
--spec visit(icode_lbl(), gb_set()) -> gb_set().
+-spec is_visited(icode_lbl(), gb_sets:set()) -> boolean().
+-spec visit(icode_lbl(), gb_sets:set()) -> gb_sets:set().
-spec bb(cfg(), icode_lbl()) -> 'not_found' | bb().
-spec bb_add(cfg(), icode_lbl(), bb()) -> cfg().
diff --git a/lib/hipe/icode/hipe_icode_coordinator.erl b/lib/hipe/icode/hipe_icode_coordinator.erl
index 79e3304e6f..c69db9afa9 100644
--- a/lib/hipe/icode/hipe_icode_coordinator.erl
+++ b/lib/hipe/icode/hipe_icode_coordinator.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -49,9 +49,9 @@ coordinate(CG, Escaping, NonEscaping, Mod) ->
-type mfalists() :: {[mfa()], [mfa()]}.
--spec coordinate(mfalists(), hipe_digraph:hdg(), gb_tree(),
- fun((mfalists(), gb_tree()) -> mfalists()),
- fun((gb_tree()) -> 'ok'), pid()) -> no_return().
+-spec coordinate(mfalists(), hipe_digraph:hdg(), gb_trees:tree(),
+ fun((mfalists(), gb_trees:tree()) -> mfalists()),
+ fun((gb_trees:tree()) -> 'ok'), pid()) -> no_return().
coordinate(MFALists, CG, PM, Restart, LastAction, ServerPid) ->
case MFALists of
diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl
index 00caffb24b..6191c536ad 100644
--- a/lib/hipe/icode/hipe_icode_exceptions.erl
+++ b/lib/hipe/icode/hipe_icode_exceptions.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -397,9 +397,9 @@ get_renaming(C, Map) ->
succ :: #cfg{},
pred :: #cfg{},
start_labels :: [icode_lbl(),...],
- visited = hipe_icode_cfg:none_visited() :: gb_set(),
- out = gb_trees:empty() :: gb_tree(),
- in = gb_trees:empty() :: gb_tree()
+ visited = hipe_icode_cfg:none_visited() :: gb_sets:set(),
+ out = gb_trees:empty() :: gb_trees:tree(),
+ in = gb_trees:empty() :: gb_trees:tree()
}).
init_state(CFG) ->
diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl
index a2ca6132d1..c0cd9bd2d1 100644
--- a/lib/hipe/icode/hipe_icode_fp.erl
+++ b/lib/hipe/icode/hipe_icode_fp.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -33,8 +33,8 @@
-include("hipe_icode.hrl").
-include("../flow/cfg.hrl").
--record(state, {edge_map = gb_trees:empty() :: gb_tree(),
- fp_ebb_map = gb_trees:empty() :: gb_tree(),
+-record(state, {edge_map = gb_trees:empty() :: gb_trees:tree(),
+ fp_ebb_map = gb_trees:empty() :: gb_trees:tree(),
cfg :: #cfg{}}).
%%--------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode_instruction_counter.erl b/lib/hipe/icode/hipe_icode_instruction_counter.erl
index 92658d294a..f44adfe149 100644
--- a/lib/hipe/icode/hipe_icode_instruction_counter.erl
+++ b/lib/hipe/icode/hipe_icode_instruction_counter.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -64,7 +64,8 @@ walktrough_bb(BB, Info) ->
%% The counter specific functions
%%-------------------------------------------------------------------
--spec compare(gb_tree(), gb_tree(), gb_tree()) -> gb_tree().
+-spec compare(gb_trees:tree(), gb_trees:tree(), gb_trees:tree()) ->
+ gb_trees:tree().
compare(Name, Old, New) ->
NewList = gb_trees:to_list(New),
diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl
index 1a2cbfae31..fbc58f3568 100644
--- a/lib/hipe/icode/hipe_icode_range.erl
+++ b/lib/hipe/icode/hipe_icode_range.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -72,8 +72,8 @@
-type final_fun() :: fun((mfa(), [range()]) -> 'ok').
-type data() :: {mfa(), args_fun(), call_fun(), final_fun()}.
-type label() :: non_neg_integer().
--type info() :: gb_tree().
--type work_list() :: {[label()], [label()], set()}.
+-type info() :: gb_trees:tree().
+-type work_list() :: {[label()], [label()], sets:set()}.
-type variable() :: #icode_variable{}.
-type annotated_variable() :: #icode_variable{}.
-type argument() :: #icode_const{} | variable().
@@ -82,9 +82,9 @@
-type last_instr_return() :: {instr_split_info(), range()}.
-record(state, {info_map = gb_trees:empty() :: info(),
- counter = dict:new() :: dict(),
+ counter = dict:new() :: dict:dict(),
cfg :: cfg(),
- liveness = gb_trees:empty() :: gb_tree(),
+ liveness = gb_trees:empty() :: gb_trees:tree(),
ret_type :: range(),
lookup_fun :: call_fun(),
result_action :: final_fun()}).
diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl
index 4607a96dda..2c4b6d9409 100644
--- a/lib/hipe/icode/hipe_icode_ssa.erl
+++ b/lib/hipe/icode/hipe_icode_ssa.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -37,7 +37,7 @@
-include("../ssa/hipe_ssa.inc").
%% Declarations for exported functions which are Icode-specific.
--spec ssa_liveness__analyze(#cfg{}) -> gb_tree().
+-spec ssa_liveness__analyze(#cfg{}) -> gb_trees:tree().
-spec ssa_liveness__livein(_, icode_lbl()) -> [#icode_variable{}].
%% -spec ssa_liveness__livein(_, icode_lbl(), _) -> [#icode_var{}].
diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
index 2337ef9323..772e30eada 100644
--- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
+++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -70,9 +70,9 @@
%% var - maps variables to expression value numbers. These variables are
%% defined or used by the structure expressions.
--record(maps, {var = gb_trees:empty() :: gb_tree(),
- instr = gb_trees:empty() :: gb_tree(),
- expr = gb_trees:empty() :: gb_tree()}).
+-record(maps, {var = gb_trees:empty() :: gb_trees:tree(),
+ instr = gb_trees:empty() :: gb_trees:tree(),
+ expr = gb_trees:empty() :: gb_trees:tree()}).
maps_var(#maps{var = Out}) -> Out.
maps_instr(#maps{instr = Out}) -> Out.
@@ -211,10 +211,10 @@ varinfo_use_add(#varinfo{use = UseSet} = I, Use) ->
pred = none :: 'none' | [icode_lbl()],
succ = none :: 'none' | [icode_lbl()],
code = [] :: [tuple()], % [illegal_icode_instr()]
- phi = gb_trees:empty() :: gb_tree(),
+ phi = gb_trees:empty() :: gb_trees:tree(),
varmap = [] :: [{icode_var(), icode_var()}],
pre_loop = false :: boolean(),
- non_struct_defs = gb_sets:new() :: gb_set(),
+ non_struct_defs = gb_sets:new() :: gb_sets:set(),
up_expr = none :: 'none' | ?SETS:?SET(_),
killed_expr = none :: 'none' | ?SETS:?SET(_),
sub_inserts = ?SETS:new() :: ?SETS:?SET(_),
@@ -319,7 +319,7 @@ node_create(Label, Pred, Succ) ->
start_label = none :: 'none' | icode_lbl(),
rev_postorder = none :: 'none' | [icode_lbl()],
all_expr = none :: 'none' | [non_neg_integer()],
- tree = gb_trees:empty() :: gb_tree()}).
+ tree = gb_trees:empty() :: gb_trees:tree()}).
nodes_postorder(#nodes{postorder = Out}) -> Out.
nodes_rev_postorder(#nodes{rev_postorder = Out}) -> Out.
@@ -356,7 +356,7 @@ nodes_create() -> #nodes{}.
%% del_red_test - flag that is set to true when the reduction test
%% has been inserted is used to move the reduction test.
--record(update, {inserted = gb_trees:empty() :: gb_tree(),
+-record(update, {inserted = gb_trees:empty() :: gb_trees:tree(),
del_red_test = false :: boolean()}).
update_inserted_lookup(#update{inserted = Inserted}, ExprId) ->
diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl
index 046949d2f2..65876b83ea 100644
--- a/lib/hipe/icode/hipe_icode_type.erl
+++ b/lib/hipe/icode/hipe_icode_type.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -97,9 +97,9 @@
t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2,
t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]).
--record(state, {info_map = gb_trees:empty() :: gb_tree(),
+-record(state, {info_map = gb_trees:empty() :: gb_trees:tree(),
cfg :: cfg(),
- liveness = gb_trees:empty() :: gb_tree(),
+ liveness = gb_trees:empty() :: gb_trees:tree(),
arg_types :: [erl_types:erl_type()],
ret_type = [t_none()] :: [erl_types:erl_type()],
lookupfun :: call_fun(),
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index 7db4db8a57..bcdfcb0e03 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -192,7 +192,6 @@
hipe_tagscheme,
hipe_temp_map,
hipe_timing,
- hipe_tool,
hipe_vectors,
hipe_x86,
hipe_x86_assemble,
diff --git a/lib/hipe/main/hipe.appup.src b/lib/hipe/main/hipe.appup.src
index 1d5a0d93f5..02679fab21 100644
--- a/lib/hipe/main/hipe.appup.src
+++ b/lib/hipe/main/hipe.appup.src
@@ -1,7 +1,7 @@
-%%
+%% -*- erlang -*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -15,5 +15,4 @@
%% under the License.
%%
%% %CopyrightEnd%
-%%
-{"%VSN%",[],[]}.
+{"%VSN%", [], []}.
diff --git a/lib/hipe/misc/hipe_consttab.erl b/lib/hipe/misc/hipe_consttab.erl
index c381e6a057..2b02f54b5c 100644
--- a/lib/hipe/misc/hipe_consttab.erl
+++ b/lib/hipe/misc/hipe_consttab.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -462,7 +462,7 @@ update_referred_labels(Table, LabelMap) ->
tree_keys(T) ->
dict:fetch_keys(T).
--spec tree_to_list(dict()) -> [{_, _}].
+-spec tree_to_list(dict:dict()) -> [{_, _}].
tree_to_list(T) ->
dict:to_list(T).
@@ -486,11 +486,11 @@ tree_lookup(Key, T) ->
none
end.
--spec tree_empty() -> dict().
+-spec tree_empty() -> dict:dict().
tree_empty() ->
dict:new().
--spec tree_lookup_key_for_value(ctdata(), dict()) -> 'none' | {'value', _}.
+-spec tree_lookup_key_for_value(ctdata(), dict:dict()) -> 'none' | {'value', _}.
tree_lookup_key_for_value(Val, T) ->
tree_lookup_key_for_value_1(tree_to_list(T), Val).
diff --git a/lib/hipe/misc/hipe_consttab.hrl b/lib/hipe/misc/hipe_consttab.hrl
index 39018dac34..aea3c5bc88 100644
--- a/lib/hipe/misc/hipe_consttab.hrl
+++ b/lib/hipe/misc/hipe_consttab.hrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -22,6 +22,6 @@
-type ct_alignment() :: 4 | 8.
-type hipe_constlbl() :: non_neg_integer().
--type hipe_consttab() :: {dict(), [hipe_constlbl()], hipe_constlbl()}.
+-type hipe_consttab() :: {dict:dict(), [hipe_constlbl()], hipe_constlbl()}.
%%-----------------------------------------------------------------------------
diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl
index e214d7ebbc..ca8a9e6bf7 100644
--- a/lib/hipe/misc/hipe_pack_constants.erl
+++ b/lib/hipe/misc/hipe_pack_constants.erl
@@ -3,7 +3,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -198,7 +198,7 @@ compact_dests([], Dest, AccofDest, Acc) ->
slim_constmap(Map) ->
slim_constmap(Map, gb_sets:new(), []).
--spec slim_constmap([#pcm_entry{}], gb_set(), [raw_data()]) -> [raw_data()].
+-spec slim_constmap([#pcm_entry{}], gb_sets:set(), [raw_data()]) -> [raw_data()].
slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset,
type=Type, raw_data=Term}|Rest], Inserted, Acc) ->
case gb_sets:is_member(ConstNo, Inserted) of
diff --git a/lib/hipe/misc/hipe_sdi.erl b/lib/hipe/misc/hipe_sdi.erl
index ef1b5b48c5..9a2ff78ecf 100644
--- a/lib/hipe/misc/hipe_sdi.erl
+++ b/lib/hipe/misc/hipe_sdi.erl
@@ -3,7 +3,7 @@
%%%
%%% %CopyrightBegin%
%%%
-%%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%%
%%% The contents of this file are subject to the Erlang Public License,
%%% Version 1.1, (the "License"); you may not use this file except in
@@ -50,7 +50,7 @@
-record(pass1, {prevSdi :: integer(),
preS = [] :: [#pre_sdi_data{}],
- labelMap = gb_trees:empty() :: gb_tree()}).
+ labelMap = gb_trees:empty() :: gb_trees:tree()}).
-record(sdi_data, {address :: address(),
label_address :: address(),
@@ -105,11 +105,11 @@ pass1_add_sdi(Pass1, Address, Label, SdiInfo) ->
PreSdiData = #pre_sdi_data{address=Address, label=Label, si=SdiInfo},
Pass1#pass1{prevSdi=PrevSdi+1, preS=[PreSdiData|PreS]}.
--spec pass1_finalise(#pass1{}) -> {non_neg_integer(),tuple(),gb_tree()}.
+-spec pass1_finalise(#pass1{}) -> {non_neg_integer(),tuple(),gb_trees:tree()}.
pass1_finalise(#pass1{prevSdi=PrevSdi, preS=PreS, labelMap=LabelMap}) ->
{PrevSdi+1, pass1_finalise_preS(PreS, LabelMap, []), LabelMap}.
--spec pass1_finalise_preS([#pre_sdi_data{}], gb_tree(), [#sdi_data{}]) ->
+-spec pass1_finalise_preS([#pre_sdi_data{}], gb_trees:tree(), [#sdi_data{}]) ->
tuple().
pass1_finalise_preS([], _LabelMap, S) -> vector_from_list(S);
pass1_finalise_preS([PreSdiData|PreS], LabelMap, S) ->
@@ -122,7 +122,7 @@ pass1_finalise_preS([PreSdiData|PreS], LabelMap, S) ->
%%% Pass2.
--spec pass2(#pass1{}) -> {gb_tree(), non_neg_integer()}.
+-spec pass2(#pass1{}) -> {gb_trees:tree(), non_neg_integer()}.
pass2(Pass1) ->
{N,SDIS,LabelMap} = pass1_finalise(Pass1),
LONG = mk_long(N),
@@ -339,13 +339,14 @@ initINCR(SdiNr, PrevIncr, N, LONG, INCREMENT) ->
%%% a and previous sdi i is remapped to a+incr(i), where
%%% incr(i) = if i < 0 then 0 else INCREMENT[i].
--spec adjust_label_map(gb_tree(), hipe_array()) -> gb_tree().
+-spec adjust_label_map(gb_trees:tree(), hipe_array()) -> gb_trees:tree().
adjust_label_map(LabelMap, INCREMENT) ->
applyIncr(gb_trees:to_list(LabelMap), INCREMENT, gb_trees:empty()).
-type label_pair() :: {label(), #label_data{}}.
--spec applyIncr([label_pair()], hipe_array(), gb_tree()) -> gb_tree().
+-spec applyIncr([label_pair()], hipe_array(), gb_trees:tree()) ->
+ gb_trees:tree().
applyIncr([], _INCREMENT, LabelMap) -> LabelMap;
applyIncr([{Label,LabelData}|List], INCREMENT, LabelMap) ->
#label_data{address=Address, prevSdi=PrevSdi} = LabelData,
diff --git a/lib/hipe/regalloc/hipe_ig_moves.erl b/lib/hipe/regalloc/hipe_ig_moves.erl
index 186c87a690..ebc6ebc20d 100644
--- a/lib/hipe/regalloc/hipe_ig_moves.erl
+++ b/lib/hipe/regalloc/hipe_ig_moves.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -36,7 +36,7 @@
-record(ig_moves, {movelist :: hipe_vector(),
nrmoves = 0 :: non_neg_integer(),
moveinsns = [] :: [{_,_}],
- moveset = gb_sets:empty() :: gb_set()}).
+ moveset = gb_sets:empty() :: gb_sets:set()}).
%%-----------------------------------------------------------------------------
diff --git a/lib/hipe/ssa/hipe_ssa_const_prop.inc b/lib/hipe/ssa/hipe_ssa_const_prop.inc
index 2fce384197..0876fca34a 100644
--- a/lib/hipe/ssa/hipe_ssa_const_prop.inc
+++ b/lib/hipe/ssa/hipe_ssa_const_prop.inc
@@ -3,7 +3,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -72,10 +72,10 @@ visit_expressions([Inst | Insts], Environment, FlowWork, SSAWork) ->
%%-----------------------------------------------------------------------------
-record(env, {cfg :: #cfg{},
- executable_flags = gb_sets:empty() :: gb_set(),
- handled_blocks = gb_sets:empty() :: gb_set(),
- lattice_values = gb_trees:empty() :: gb_tree(),
- ssa_edges = gb_trees:empty() :: gb_tree()
+ executable_flags = gb_sets:empty() :: gb_sets:set(),
+ handled_blocks = gb_sets:empty() :: gb_sets:set(),
+ lattice_values = gb_trees:empty() :: gb_trees:tree(),
+ ssa_edges = gb_trees:empty() :: gb_trees:tree()
}).
create_env(CFG) ->
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
new file mode 100644
index 0000000000..cedb150b5d
--- /dev/null
+++ b/lib/hipe/test/Makefile
@@ -0,0 +1,73 @@
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+ hipe_SUITE
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+INSTALL_PROGS= $(TARGET_FILES)
+
+# ----------------------------------------------------
+# Files
+# ----------------------------------------------------
+EMAKEFILE = Emakefile
+AUXILIARY_FILES = hipe.spec hipe_testsuite_driver.erl $(EMAKEFILE)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/hipe_test
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+ERL_MAKE_FLAGS +=
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+
+EBIN = .
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+make_emakefile:
+ $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
+ > $(EMAKEFILE)
+ $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \
+ >> $(EMAKEFILE)
+
+tests debug opt: make_emakefile
+ erl $(ERL_MAKE_FLAGS) -make
+
+clean:
+ rm -f $(EMAKEFILE)
+ rm -f $(TARGET_FILES) $(GEN_FILES)
+ rm -f core
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+
+release_docs_spec:
+
+release_tests_spec: make_emakefile
+ $(INSTALL_DIR) "$(RELSYSDIR)"
+ chmod -R u+w "$(RELSYSDIR)"
+ $(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
new file mode 100644
index 0000000000..2894f40354
--- /dev/null
+++ b/lib/hipe/test/hipe.spec
@@ -0,0 +1,6 @@
+%% -*- erlang -*-
+
+{alias, tests, "../hipe_test"}.
+
+{suites, tests, all}.
+
diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl
new file mode 100644
index 0000000000..554bc972f6
--- /dev/null
+++ b/lib/hipe/test/hipe_SUITE.erl
@@ -0,0 +1,55 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+-module(hipe_SUITE).
+
+-compile([export_all]).
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks, [ts_install_cth]}].
+
+all() ->
+ [app, appup].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ case erlang:system_info(hipe_architecture) of
+ undefined -> {skip, "HiPE not available or enabled"};
+ _ -> Config
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+app() ->
+ [{doc, "Test that the hipe app file is ok"}].
+app(Config) when is_list(Config) ->
+ ok = ?t:app_test(hipe, tolerant).
+
+appup() ->
+ [{doc, "Test that the hipe appup file is ok"}].
+appup(Config) when is_list(Config) ->
+ AppupFile = "hipe.appup",
+ AppupPath = filename:join([code:lib_dir(hipe), "ebin", AppupFile]),
+ {ok, [{_Vsn, [], []}]} = file:consult(AppupPath).
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.
diff --git a/lib/hipe/util/hipe_digraph.erl b/lib/hipe/util/hipe_digraph.erl
index fcfaa64684..01b1f8c77c 100644
--- a/lib/hipe/util/hipe_digraph.erl
+++ b/lib/hipe/util/hipe_digraph.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -36,10 +36,10 @@
-type ordset(T) :: [T]. % XXX: temporarily
--record(hipe_digraph, {edges = dict:new() :: dict(),
- rev_edges = dict:new() :: dict(),
+-record(hipe_digraph, {edges = dict:new() :: dict:dict(),
+ rev_edges = dict:new() :: dict:dict(),
leaves = ordsets:new() :: ordset(_), % ???
- nodes = sets:new() :: set()}).
+ nodes = sets:new() :: sets:set()}).
-opaque hdg() :: #hipe_digraph{}.
diff --git a/lib/hipe/util/hipe_dot.erl b/lib/hipe/util/hipe_dot.erl
index e4a47ae0c4..94f7fd60cc 100644
--- a/lib/hipe/util/hipe_dot.erl
+++ b/lib/hipe/util/hipe_dot.erl
@@ -2,7 +2,7 @@
%%%
%%% %CopyrightBegin%
%%%
-%%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
+%%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%%
%%% The contents of this file are subject to the Erlang Public License,
%%% Version 1.1, (the "License"); you may not use this file except in
@@ -70,13 +70,13 @@
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--spec translate_digraph(digraph(), string(), string()) -> 'ok'.
+-spec translate_digraph(digraph:graph(), string(), string()) -> 'ok'.
translate_digraph(G, FileName, GName) ->
translate_digraph(G, FileName, GName,
fun(X) -> io_lib:format("~p", [X]) end, []).
--spec translate_digraph(digraph(), string(), string(),
+-spec translate_digraph(digraph:graph(), string(), string(),
fun((_) -> string()), [_]) -> 'ok'.
translate_digraph(G, FileName, GName, Fun, Opts) ->
diff --git a/lib/hipe/util/hipe_vectors.hrl b/lib/hipe/util/hipe_vectors.hrl
index 043faf4c91..5e24db238d 100644
--- a/lib/hipe/util/hipe_vectors.hrl
+++ b/lib/hipe/util/hipe_vectors.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,5 +24,5 @@
-endif.
-ifdef(USE_GBTREES).
--type hipe_vector() :: gb_tree().
+-type hipe_vector() :: gb_trees:tree().
-endif.