aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2011-09-27 11:49:14 +0200
committerAnders Svensson <[email protected]>2011-09-27 11:49:14 +0200
commit571bc8c6135cb902e7cf9429f1bfad67284f8f23 (patch)
tree31b618935858320435884a80cf868b7cf22d5d42 /lib/diameter
parent67e216c86754e7076ffdbb87fec8b48ab0d28e56 (diff)
parent1c9017d8970713a24a36929063bcc76a28ae54c5 (diff)
downloadotp-571bc8c6135cb902e7cf9429f1bfad67284f8f23.tar.gz
otp-571bc8c6135cb902e7cf9429f1bfad67284f8f23.tar.bz2
otp-571bc8c6135cb902e7cf9429f1bfad67284f8f23.zip
Merge branch 'dev' into major
Diffstat (limited to 'lib/diameter')
-rw-r--r--lib/diameter/doc/src/diameter.xml37
-rw-r--r--lib/diameter/doc/src/diameter_app.xml47
-rw-r--r--lib/diameter/doc/src/diameter_sctp.xml10
-rw-r--r--lib/diameter/doc/src/diameter_tcp.xml13
-rw-r--r--lib/diameter/include/diameter_gen.hrl4
-rw-r--r--lib/diameter/src/app/Makefile4
-rw-r--r--lib/diameter/src/app/diameter_codec.erl22
-rw-r--r--lib/diameter/src/app/diameter_config.erl11
-rw-r--r--lib/diameter/src/app/diameter_internal.hrl23
-rw-r--r--lib/diameter/src/app/diameter_lib.erl28
-rw-r--r--lib/diameter/src/app/diameter_peer.erl11
-rw-r--r--lib/diameter/src/app/diameter_reg.erl12
-rw-r--r--lib/diameter/src/app/diameter_service.erl200
-rw-r--r--lib/diameter/src/app/diameter_stats.erl11
-rw-r--r--lib/diameter/src/app/diameter_sync.erl35
-rw-r--r--lib/diameter/src/compiler/diameter_codegen.erl1
-rw-r--r--lib/diameter/test/.gitignore3
-rw-r--r--lib/diameter/test/Makefile369
-rw-r--r--lib/diameter/test/depend.sed31
-rw-r--r--lib/diameter/test/diameter.spec8
-rw-r--r--lib/diameter/test/diameter_SUITE.erl108
-rw-r--r--lib/diameter/test/diameter_app_SUITE.erl249
-rw-r--r--lib/diameter/test/diameter_app_test.erl393
-rw-r--r--lib/diameter/test/diameter_appup_test.erl539
-rw-r--r--lib/diameter/test/diameter_codec_SUITE.erl77
-rw-r--r--lib/diameter/test/diameter_codec_test.erl500
-rw-r--r--lib/diameter/test/diameter_compiler_test.erl104
-rw-r--r--lib/diameter/test/diameter_config_test.erl105
-rw-r--r--lib/diameter/test/diameter_ct.erl55
-rw-r--r--lib/diameter/test/diameter_ct.hrl21
-rw-r--r--lib/diameter/test/diameter_dict_SUITE.erl151
-rw-r--r--lib/diameter/test/diameter_enum.erl406
-rw-r--r--lib/diameter/test/diameter_etcp_test.beambin1808 -> 0 bytes
-rw-r--r--lib/diameter/test/diameter_peer_test.erl104
-rw-r--r--lib/diameter/test/diameter_reg_SUITE.erl119
-rw-r--r--lib/diameter/test/diameter_reg_test.erl104
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl422
-rw-r--r--lib/diameter/test/diameter_session_test.erl104
-rw-r--r--lib/diameter/test/diameter_stats_SUITE.erl92
-rw-r--r--lib/diameter/test/diameter_stats_test.erl104
-rw-r--r--lib/diameter/test/diameter_sync_SUITE.erl139
-rw-r--r--lib/diameter/test/diameter_sync_test.erl104
-rw-r--r--lib/diameter/test/diameter_tcp_test.erl482
-rw-r--r--lib/diameter/test/diameter_test_lib.erl478
-rw-r--r--lib/diameter/test/diameter_test_lib.hrl106
-rw-r--r--lib/diameter/test/diameter_test_server.erl551
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl779
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl458
-rw-r--r--lib/diameter/test/diameter_util.erl177
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl540
-rw-r--r--lib/diameter/test/modules.mk39
-rw-r--r--lib/diameter/test/slask/diameter_persistent_table_test.erl495
52 files changed, 4545 insertions, 4440 deletions
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 36b6cbf0cf..2cad70e3bc 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -277,6 +277,10 @@ callback.</p>
</taglist>
+<p>
+An invalid option will cause <seealso marker="#call">call/4</seealso>
+to fail.</p>
+
<marker id="capability"/>
</item>
@@ -405,6 +409,8 @@ sense.</p>
<code>
eval([{M,F,A} | T]) ->
apply(M, F, T ++ A);
+eval([[F|A] | T]) ->
+ eval([F | T ++ A]);
eval([F|A]) ->
apply(F, A);
eval(F) ->
@@ -461,14 +467,14 @@ or any peer if the request does not contain
a <c>Destination-Realm</c> AVP.</p>
</item>
-<tag><c>{host, any|UTF8String()}</c></tag>
+<tag><c>{host, any|DiameterIdentity()}</c></tag>
<item>
<p>
Matches only those peers whose <c>Origin-Host</c> has the
specified value, or all peers if the atom <c>any</c>.</p>
</item>
-<tag><c>{realm, any|UTF8String()</c></tag>
+<tag><c>{realm, any|DiameterIdentity()</c></tag>
<item>
<p>
Matches only those peers whose <c>Origin-Realm</c> has the
@@ -478,8 +484,9 @@ value, or all peers if the atom <c>any</c>.</p>
<tag><c>{eval, evaluable()}</c></tag>
<item>
<p>
-Matches only those peers for which the specified evaluable() evaluates
-to true on the peer's <c>diameter_caps</c> record.</p>
+Matches only those peers for which the specified evaluable() returns
+<c>true</c> on the connection's <c>diameter_caps</c> record.
+Any other return value or exception is equivalent to <c>false</c>.</p>
</item>
<tag><c>{neg, peer_filter()}</c></tag>
@@ -503,6 +510,21 @@ specified list.</p>
</taglist>
+<p>
+Note that the <c>host</c> and <c>realm</c> filters examine the
+outgoing request as passed to <seealso marker="#call">call/4</seealso>,
+assuming that this is a record- or list-valued message() as documented
+in <seealso marker="diameter_app">diameter_app(3)</seealso>, and that
+the message contains at most one of each AVP.
+If this is not the case then the <c>{host|realm, DiameterIdentity()}</c>
+filters must be used to achieve the desired result.
+Note also that an empty host/realm (which should not be typical)
+is equivalent to an unspecified one for the purposes of filtering.</p>
+
+<p>
+An invalid filter is equivalent to <c>{any, []}</c>, a filter
+that matches no peer.</p>
+
<marker id="service_event"/>
</item>
@@ -787,7 +809,7 @@ transports.</p>
<type>
<v>SvcName = service_name()</v>
<v>App = application_alias()</v>
-<v>Request = diameter_app:message()</v>
+<v>Request = diameter_app:message() | term()</v>
<v>Answer = term()</v>
<v>Options = [call_opt()]</v>
</type>
@@ -819,9 +841,8 @@ If there are no suitable peers, or if
<seealso marker="diameter_app#pick_peer">pick_peer/4</seealso>
rejects them by returning 'false', then <c>{error, no_connection}</c>
is returned.
-If <seealso marker="diameter_app#pick_peer">pick_peer/4</seealso>
-selects a candidate peer then a request process is spawned for the
-outgoing request, in which there is a
+Otherwise <seealso marker="diameter_app#pick_peer">pick_peer/4</seealso>
+is followed by a
<seealso
marker="diameter_app#prepare_request">prepare_request/3</seealso>
callback, the message is encoded and sent.</p>
diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml
index fc359b9d1d..a9ae0ebbec 100644
--- a/lib/diameter/doc/src/diameter_app.xml
+++ b/lib/diameter/doc/src/diameter_app.xml
@@ -269,7 +269,12 @@ The candidate peers list will only include those
which are selected by any <c>filter</c> option specified in the call to
<seealso marker="diameter#call">diameter:call/4</seealso>, and only
those which have indicated support for the Diameter application in
-question.</p>
+question.
+The order of the elements is unspecified except that any
+peers whose Origin-Host and Origin-Realm matches that of the
+outgoing request (in the sense of a <c>{filter, {all, [host, realm]}}</c>
+option to <seealso marker="diameter#call">diameter:call/4</seealso>)
+will be placed at the head of the list.</p>
<p>
The return values <c>false</c> and <c>{false, State}</c> are
@@ -467,11 +472,11 @@ callback returned false.</p>
<v>Packet = packet()</v>
<v>SvcName = term()</v>
<v>Peer = peer()</v>
-<v>Action = Reply | {relay, Opts} | discard | {eval, Action, ContF}</v>
+<v>Action = Reply | {relay, Opts} | discard | {eval, Action, PostF}</v>
<v>Reply = {reply, message()}
| {protocol_error, 3000..3999}</v>
<v>Opts = diameter:call_opts()</v>
-<v>ContF = diameter:evaluable()</v>
+<v>PostF = diameter:evaluable()</v>
</type>
<desc>
<p>
@@ -559,26 +564,28 @@ will cause the request process in question to fail.</p>
<tag><c>{relay, Opts}</c></tag>
<item>
<p>
-Relay a request to another peer.
-The appropriate Route-Record AVP will be added to the relayed request
-by diameter and <seealso marker="#pick_peer">pick_peer/4</seealso>
-and <seealso marker="#prepare_request">prepare_request/3</seealso>
-callback will take place just as if <seealso
+Relay a request to another peer in the role of a Diameter relay agent.
+If a routing loop is detected then the request is answered with
+3005 (DIAMETER_LOOP_DETECTED).
+Otherwise a Route-Record AVP (containing the sending peer's Origin-Host) is
+added to the request and <seealso marker="#pick_peer">pick_peer/4</seealso>
+and subsequent callbacks take place just as if <seealso
marker="diameter#call">diameter:call/4</seealso> had been called
explicitly.
-However, returning a <c>relay</c> tuple also causes the End-to-End
-Identifier to be preserved in the header of the relayed request as
-required by RFC 3588.</p>
+The End-to-End Identifier of the incoming request is preserved in the
+header of the relayed request.</p>
<p>
-The returned <c>Opts</c> should not specify <c>detach</c> and
-the <seealso marker="#handle_answer">handle_answer/4</seealso>
-callback following from a relayed request must return its first
+The returned <c>Opts</c> should not specify <c>detach</c>.
+A subsequent <seealso marker="#handle_answer">handle_answer/4</seealso>
+callback for the relayed request must return its first
argument, the <c>diameter_packet</c> record containing the answer
message.
Note that the <c>extra</c> option can be specified to supply arguments
-that can distinguish the relay case from others if so desired,
-although the form of the request message may be sufficient.</p>
+that can distinguish the relay case from others if so desired.
+Any other return value (for example, from a
+<seealso marker="#handle_error">handle_error/4</seealso> callback)
+causes the request to be answered with 3002 (DIAMETER_UNABLE_TO_DELIVER).</p>
</item>
<tag><c>discard</c></tag>
@@ -587,18 +594,18 @@ although the form of the request message may be sufficient.</p>
Discard the request.</p>
</item>
-<tag><c>{eval, Action, ContF}</c></tag>
+<tag><c>{eval, Action, PostF}</c></tag>
<item>
<p>
Handle the request as if <c>Action</c> has been returned and then
-evaluate <c>ContF</c> in the request process.</p>
+evaluate <c>PostF</c> in the request process.</p>
</item>
</taglist>
<p>
-Note that diameter will respond to protocol errors in an incoming
-request without invoking <c>handle_request/3</c>.</p>
+Note that protocol errors detected by diameter will result in an
+answer message without <c>handle_request/3</c> being invoked.</p>
</desc>
</func>
diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml
index d0377f4b38..c1e839b8e1 100644
--- a/lib/diameter/doc/src/diameter_sctp.xml
+++ b/lib/diameter/doc/src/diameter_sctp.xml
@@ -74,11 +74,12 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</p>
<p>
The only diameter_sctp-specific argument is the options list.
Options <c>raddr</c> and <c>rport</c> specify the remote address
-and port for a connector and not valid for a listener.
+and port for a connecting transport and not valid for a listening
+transport.
The former is required while latter defaults to 3868 if unspecified.
More than one <c>raddr</c> option can be specified, in which case the
-connector in question attempts each in sequence until an association
-is established.
+connecting transport in question attempts each in sequence until
+an association is established.
Remaining options are any accepted by gen_sctp:open/1, with the exception
of options <c>mode</c>, <c>binary</c>, <c>list</c>, <c>active</c>
and <c>sctp_events</c>.
@@ -89,7 +90,8 @@ and port respectively.</p>
Multiple <c>ip</c> options can be specified for a multihomed peer.
If none are specified then the values of Host-IP-Address
on the service are used. (In particular, one of these must be specified.)
-Option <c>port</c> defaults to 3868 for a listener and 0 for a connector.</p>
+Option <c>port</c> defaults to 3868 for a listening transport and 0 for a
+connecting transport.</p>
<p>
diameter_sctp uses the <c>transport_data</c> field of
diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml
index 5d6e07b1b8..a502e53972 100644
--- a/lib/diameter/doc/src/diameter_tcp.xml
+++ b/lib/diameter/doc/src/diameter_tcp.xml
@@ -74,13 +74,14 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</p>
<p>
The only diameter_tcp-specific argument is the options list.
Options <c>raddr</c> and <c>rport</c> specify the remote address
-and port for a connector and not valid for a listener.
+and port for a connecting transport and not valid for a listening
+transport.
Remaining options are any accepted by gen_tcp:connect/3 for
-a connector, or gen_tcp:listen/2 for a listener, with the exception
-of <c>binary</c>, <c>packet</c> and <c>active</c>.
-Also, option <c>port</c> can be specified for a listener to specify the
-local listening port, the default being the standardized 3868 if
-unspecified.
+a connecting transport, or gen_tcp:listen/2 for a listening transport,
+with the exception of <c>binary</c>, <c>packet</c> and <c>active</c>.
+Also, option <c>port</c> can be specified for a listening transport
+to specify the local listening port, the default being the standardized
+3868 if unspecified.
Note that option <c>ip</c> specifies the local address.</p>
<p>
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index 4c91954a21..d037e1044a 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -44,14 +44,14 @@ encode_avps(Name, Rec) ->
?MODULE,
?LINE,
{Reason, Name, Rec}),
- erlang:error(list_to_tuple(Reason ++ [Name, Rec, ?MODULE]));
+ erlang:error(list_to_tuple(Reason ++ [Name]));
error: Reason ->
Stack = erlang:get_stacktrace(),
diameter_dbg:log({encode, failure},
?MODULE,
?LINE,
{Reason, Name, Rec, Stack}),
- erlang:error({encode_failure, Reason, Name, Rec, ?MODULE, Stack})
+ erlang:error({encode_failure, Reason, Name, Stack})
end.
%% encode/2
diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile
index 31344fa80b..80e1fc7be2 100644
--- a/lib/diameter/src/app/Makefile
+++ b/lib/diameter/src/app/Makefile
@@ -190,6 +190,10 @@ release_docs_spec:
# Dependencies
# ----------------------------------------------------
+$(SPEC_FILES:%.dia=$(EBIN)/%.$(EMULATOR)): \
+ $(DIAMETER_TOP)/include/diameter.hrl \
+ $(DIAMETER_TOP)/include/diameter_gen.hrl
+
depend: depend.mk
# Generate dependencies makefile. It's assumed that the compile target
diff --git a/lib/diameter/src/app/diameter_codec.erl b/lib/diameter/src/app/diameter_codec.erl
index f6cbde5446..d88f42fb7c 100644
--- a/lib/diameter/src/app/diameter_codec.erl
+++ b/lib/diameter/src/app/diameter_codec.erl
@@ -140,10 +140,10 @@ make_flags(Flags0, #diameter_header{is_request = R,
mf(undefined, F, _) ->
F;
mf(B, F, N) -> %% reset the affected bit
- (F bxor (F band (1 bsl N))) bor (bit(B) bsl N).
+ (F bxor (F band (1 bsl N))) bor bit(B, N).
-bit(true) -> 1;
-bit(false) -> 0.
+bit(true, N) -> 1 bsl N;
+bit(false, _) -> 0.
%% values/1
@@ -199,25 +199,16 @@ msg_header(Mod, MsgName, Header) ->
p(Flags, #diameter_header{is_request = true,
is_proxiable = P}) ->
- Flags bor choose(P, 2#01000000, 0);
+ Flags band (2#10110000 bor choose(P, 2#01000000, 0));
p(Flags, _) ->
Flags.
-%% The header below is that of the incoming request being answered,
-%% not of the answer (which hasn't been encoded yet).
-
h(Mod, 'answer-message' = MsgName, Header) ->
?BASE = Mod,
- #diameter_header{is_request = true,
- cmd_code = Code}
- = Header,
+ #diameter_header{cmd_code = Code} = Header,
{_, Flags, ApplId} = ?BASE:msg_header(MsgName),
{Code, Flags, ApplId};
-h(Mod, MsgName, #diameter_header{is_request = true,
- cmd_code = Code}) ->
- {Code, _, _} = Mod:msg_header(MsgName); %% ensure Code
-
h(Mod, MsgName, _) ->
Mod:msg_header(MsgName).
@@ -290,7 +281,8 @@ decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ...
decode_avps('', Mod, Pkt, Avps) -> %% unknown message ...
?LOG(unknown, {Mod, Pkt#diameter_packet.header}),
- Pkt#diameter_packet{errors = lists:reverse(Avps)};
+ Pkt#diameter_packet{avps = lists:reverse(Avps),
+ errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED
%% msg = undefined identifies this case.
decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
diff --git a/lib/diameter/src/app/diameter_config.erl b/lib/diameter/src/app/diameter_config.erl
index 42c70890b3..a6b48fe65b 100644
--- a/lib/diameter/src/app/diameter_config.erl
+++ b/lib/diameter/src/app/diameter_config.erl
@@ -267,7 +267,7 @@ handle_call(uptime, _, #state{id = Time} = State) ->
{reply, diameter_lib:now_diff(Time), State};
handle_call(Req, From, State) ->
- warning_msg("received unexpected request from ~p:~n~w", [From, Req]),
+ ?UNEXPECTED([Req, From]),
Reply = {error, {bad_request, Req}},
{reply, Reply, State}.
@@ -276,7 +276,7 @@ handle_call(Req, From, State) ->
%%% ----------------------------------------------------------
handle_cast(Msg, State) ->
- warning_msg("received unexpected message:~n~w", [Msg]),
+ ?UNEXPECTED([Msg]),
{noreply, State}.
%%% ----------------------------------------------------------
@@ -309,7 +309,7 @@ handle_info(restart, State) ->
{noreply, State};
handle_info(Info, State) ->
- warning_msg("received unknown info:~n~w", [Info]),
+ ?UNEXPECTED([Info]),
{noreply, State}.
%%--------------------------------------------------------------------
@@ -674,8 +674,3 @@ cb(M,F) ->
call(Request) ->
gen_server:call(?SERVER, Request, infinity).
-
-%% warning_msg/2
-
-warning_msg(F, A) ->
- ?diameter_warning("~p: " ++ F, [?MODULE | A]).
diff --git a/lib/diameter/src/app/diameter_internal.hrl b/lib/diameter/src/app/diameter_internal.hrl
index 9de3914830..78645b1912 100644
--- a/lib/diameter/src/app/diameter_internal.hrl
+++ b/lib/diameter/src/app/diameter_internal.hrl
@@ -37,9 +37,10 @@
%% Failure reports always get a stack trace.
-define(STACK, erlang:get_stacktrace()).
-%% Info report for anything unexpected.
--define(REPORT(Reason, Func, Args),
- diameter_lib:report(Reason, {?MODULE, Func, Args})).
+%% Warning report for unexpected messages in various processes.
+-define(UNEXPECTED(F,A),
+ diameter_lib:warning_report(unexpected, {?MODULE, F, A})).
+-define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)).
%% Something to trace on.
-define(LOG(Slogan, Details),
@@ -77,19 +78,3 @@
server_id,
is_dynamic,
expiration}).
-
-%%%----------------------------------------------------------------------
-%%% Error/warning/info message macro(s)
-%%%----------------------------------------------------------------------
-
--define(diameter_info(F, A),
- (catch error_logger:info_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n",
- [?APPLICATION, ?MODULE, self()|A]))).
-
--define(diameter_warning(F, A),
- (catch error_logger:warning_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n",
- [?APPLICATION, ?MODULE, self()|A]))).
-
--define(diameter_error(F, A),
- (catch error_logger:error_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n",
- [?APPLICATION, ?MODULE, self()|A]))).
diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/app/diameter_lib.erl
index b5c0e1bf6a..f65e356444 100644
--- a/lib/diameter/src/app/diameter_lib.erl
+++ b/lib/diameter/src/app/diameter_lib.erl
@@ -46,14 +46,9 @@
report(Reason, MFA) ->
info_report(Reason, MFA).
-info_report(Reason, {M,F,A}) ->
- error_logger:info_report(" Reason: ~p~n"
- " Pid: ~p~n"
- " Node: ~p~n"
- " Module: ~p~n"
- " Function: ~p~n"
- "Arguments: ~p~n",
- [Reason, self(), node(), M, F, A]).
+info_report(Reason, MFA) ->
+ report(fun error_logger:info_report/1, Reason, MFA),
+ true.
%%% ---------------------------------------------------------------------------
%%% # error_report(Reason, MFA)
@@ -69,7 +64,7 @@ warning_report(Reason, MFA) ->
report(fun error_logger:warning_report/1, Reason, MFA).
report(Fun, Reason, MFA) ->
- Fun([{reason, Reason}, {who, self()}, {where, node()}, {what, MFA}]),
+ Fun([{why, Reason}, {who, self()}, {what, MFA}]),
false.
%%% ---------------------------------------------------------------------------
@@ -255,12 +250,13 @@ w(L) ->
fold_tuple(_, T, undefined) ->
T;
-fold_tuple(N, T0, T) ->
- element(2, lists:foldl(fun(X, {M,_} = A) -> {M+1, ft(X, A)} end,
- {N, T0},
- lists:nthtail(N-1, tuple_to_list(T)))).
+fold_tuple(N, T0, T1) ->
+ {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end,
+ {N, T0},
+ lists:nthtail(N-1, tuple_to_list(T1))),
+ T.
-ft(undefined, T) ->
+ft(undefined, {_, T}) ->
T;
-ft(X, {N, T}) ->
- setelement(N, T, X).
+ft(Value, {Idx, T}) ->
+ setelement(Idx, T, Value).
diff --git a/lib/diameter/src/app/diameter_peer.erl b/lib/diameter/src/app/diameter_peer.erl
index 6b8971b8ea..3e78c4caef 100644
--- a/lib/diameter/src/app/diameter_peer.erl
+++ b/lib/diameter/src/app/diameter_peer.erl
@@ -148,7 +148,7 @@ handle_call(uptime, _, #state{id = Time} = State) ->
{reply, diameter_lib:now_diff(Time), State};
handle_call(Req, From, State) ->
- warning_msg("received unexpected request from ~p:~n~w", [From, Req]),
+ ?UNEXPECTED([Req, From]),
{reply, nok, State}.
%%% ----------------------------------------------------------
@@ -156,7 +156,7 @@ handle_call(Req, From, State) ->
%%% ----------------------------------------------------------
handle_cast(Msg, State) ->
- warning_msg("received unexpected message:~n~w", [Msg]),
+ ?UNEXPECTED([Msg]),
{noreply, State}.
%%% ----------------------------------------------------------
@@ -169,7 +169,7 @@ handle_info({notify, SvcName, T}, S) ->
{noreply, S};
handle_info(Info, State) ->
- warning_msg("received unexpected info:~n~w", [Info]),
+ ?UNEXPECTED([Info]),
{noreply, State}.
%% ----------------------------------------------------------
@@ -223,8 +223,3 @@ value([], V) ->
call(Request) ->
gen_server:call(?SERVER, Request, infinity).
-
-%% warning_msg/2
-
-warning_msg(F, A) ->
- ?diameter_warning("~p: " ++ F, [?MODULE | A]).
diff --git a/lib/diameter/src/app/diameter_reg.erl b/lib/diameter/src/app/diameter_reg.erl
index 8e5f34c2c3..882b9da238 100644
--- a/lib/diameter/src/app/diameter_reg.erl
+++ b/lib/diameter/src/app/diameter_reg.erl
@@ -243,7 +243,8 @@ handle_call(state, _, State) ->
handle_call(uptime, _, #state{id = Time} = State) ->
{reply, diameter_lib:now_diff(Time), State};
-handle_call(_Req, _From, State) ->
+handle_call(Req, From, State) ->
+ ?UNEXPECTED([Req, From]),
{reply, nok, State}.
%%% ----------------------------------------------------------
@@ -251,7 +252,7 @@ handle_call(_Req, _From, State) ->
%%% ----------------------------------------------------------
handle_cast(Msg, State)->
- warning_msg("received unexpected message:~n~w", [Msg]),
+ ?UNEXPECTED([Msg]),
{noreply, State}.
%%% ----------------------------------------------------------
@@ -264,7 +265,7 @@ handle_info({'DOWN', MRef, process, Pid, _}, State) ->
{noreply, State};
handle_info(Info, State) ->
- warning_msg("received unknown info:~n~w", [Info]),
+ ?UNEXPECTED([Info]),
{noreply, State}.
%%% ----------------------------------------------------------
@@ -324,8 +325,3 @@ repl([], _, _) ->
call(Request) ->
gen_server:call(?SERVER, Request, infinity).
-
-%% warning_msg/2
-
-warning_msg(F, A) ->
- ?diameter_warning("~p: " ++ F, [?MODULE | A]).
diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/app/diameter_service.erl
index 63b0649dc4..421e36ccf5 100644
--- a/lib/diameter/src/app/diameter_service.erl
+++ b/lib/diameter/src/app/diameter_service.erl
@@ -463,7 +463,7 @@ handle_call(stop, _From, S) ->
%% stating a monitor that waits for DOWN before returning.
handle_call(Req, From, S) ->
- ?REPORT(unknown_request, ?FUNC, [Req, From]),
+ unexpected(handle_call, [Req, From], S),
{reply, nok, S}.
%%% ---------------------------------------------------------------------------
@@ -471,7 +471,7 @@ handle_call(Req, From, S) ->
%%% ---------------------------------------------------------------------------
handle_cast(Req, S) ->
- ?REPORT(unknown_request, ?FUNC, [Req]),
+ unexpected(handle_cast, [Req], S),
{noreply, S}.
%%% ---------------------------------------------------------------------------
@@ -553,8 +553,8 @@ transition({failover, TRef, Seqs}, S) ->
failover(TRef, Seqs, S),
ok;
-transition(Req, _) ->
- ?REPORT(unknown_request, ?FUNC, [Req]),
+transition(Req, S) ->
+ unexpected(handle_info, [Req], S),
ok.
%%% ---------------------------------------------------------------------------
@@ -591,6 +591,9 @@ code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) ->
%% ===========================================================================
%% ===========================================================================
+unexpected(F, A, #state{service_name = Name}) ->
+ ?UNEXPECTED(F, A ++ [Name]).
+
cb([_|_] = M, F, A) ->
eval(M, F, A);
cb(Rec, F, A) ->
@@ -1398,15 +1401,15 @@ recv_answer(Timeout,
%% is, from the last peer to which we've transmitted.
receive
- {answer = A, Ref, Rq, Pkt} -> %% Answer from peer.
+ {answer = A, Ref, Rq, Pkt} -> %% Answer from peer
{A, Rq, Pkt};
- {timeout = Reason, TRef, _} -> %% No timely reply
+ {timeout = Reason, TRef, _} -> %% No timely reply
{error, Req, Reason};
- {failover = Reason, TRef, false} -> %% No alternative peer.
+ {failover = Reason, TRef, false} -> %% No alternate peer
{error, Req, Reason};
- {failover, TRef, Transport} -> %% Resend to alternate peer.
+ {failover, TRef, Transport} -> %% Resend to alternate peer
try_retransmit(Timeout, SvcName, Req, Transport);
- {failover, TRef} -> %% May have missed failover notification.
+ {failover, TRef} -> %% May have missed failover notification
Seqs = diameter_codec:sequence_numbers(RPkt),
Pid = whois(SvcName),
is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}),
@@ -1685,9 +1688,9 @@ recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) ->
%% DIAMETER_APPLICATION_UNSUPPORTED 3007
%% A request was sent for an application that is not supported.
-recv_request(false, {_, OH, OR}, TPid, _, _, Pkt) ->
- ?LOG({error, application}, Pkt),
- reply(answer_message({OH, OR, 3007}, collect_avps(Pkt)), ?BASE, TPid, Pkt).
+recv_request(false, T, TPid, _, _, Pkt) ->
+ As = collect_avps(Pkt),
+ protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}).
collect_avps(Pkt) ->
case diameter_codec:collect_avps(Pkt) of
@@ -1706,13 +1709,9 @@ collect_avps(Pkt) ->
%% set to an unrecognized value, or that is inconsistent with the
%% AVP's definition.
%%
-recv_request({_, OH, OR}, {TPid, _}, _, #diameter_packet{errors = [Bs | _],
- bin = Bin,
- avps = Avps}
- = Pkt)
+recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt)
when is_bitstring(Bs) ->
- ?LOG({error, invalid_avp_bits}, Bin),
- reply(answer_message({OH, OR, 3009}, Avps), ?BASE, TPid, Pkt);
+ protocol_error(3009, T, TPid, Pkt);
%% Either we support this application but don't recognize the command
%% or we're a relay and the command isn't proxiable.
@@ -1722,18 +1721,15 @@ recv_request({_, OH, OR}, {TPid, _}, _, #diameter_packet{errors = [Bs | _],
%% recognize or support. This MUST be used when a Diameter node
%% receives an experimental command that it does not understand.
%%
-recv_request({_, OH, OR},
+recv_request(T,
{TPid, _},
#diameter_app{id = Id},
#diameter_packet{header = #diameter_header{is_proxiable = P},
- msg = M,
- avps = Avps,
- bin = Bin}
+ msg = M}
= Pkt)
when ?APP_ID_RELAY /= Id, undefined == M;
?APP_ID_RELAY == Id, not P ->
- ?LOG({error, command_unsupported}, Bin),
- reply(answer_message({OH, OR, 3001}, Avps), ?BASE, TPid, Pkt);
+ protocol_error(3001, T, TPid, Pkt);
%% Error bit was set on a request.
%%
@@ -1742,15 +1738,12 @@ recv_request({_, OH, OR},
%% either set to an invalid combination, or to a value that is
%% inconsistent with the command code's definition.
%%
-recv_request({_, OH, OR},
+recv_request(T,
{TPid, _},
_,
- #diameter_packet{header = #diameter_header{is_error = true},
- avps = Avps,
- bin = Bin}
+ #diameter_packet{header = #diameter_header{is_error = true}}
= Pkt) ->
- ?LOG({error, error_bit}, Bin),
- reply(answer_message({OH, OR, 3008}, Avps), ?BASE, TPid, Pkt);
+ protocol_error(3008, T, TPid, Pkt);
%% A message in a locally supported application or a proxiable message
%% in the relay application. Don't distinguish between the two since
@@ -1878,7 +1871,7 @@ resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop
resend(false,
Opts,
App,
- {SvcName, _, _},
+ {SvcName, _, _} = T,
{TPid, #diameter_caps{origin_host = {_, OH}}},
#diameter_packet{header = Hdr0,
avps = Avps}
@@ -1887,46 +1880,41 @@ resend(false,
Seq = diameter_session:sequence(),
Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq},
Msg = [Hdr, Route | Avps],
- %% Filter sender as ineligible receiver.
- reply(call(SvcName, App, Msg, [{filter, {neg, {host, OH}}} | Opts]),
- TPid,
- Pkt).
+ resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt).
%% The incoming request is relayed with the addition of a
-%% Route-Record. Note the requirement on the return from call/4.
-%% This places a requirement on the values returned by the
-%% handle_answer and handle_error callbacks of the application module
-%% in question.
+%% Route-Record. Note the requirement on the return from call/4 below,
+%% which places a requirement on the value returned by the
+%% handle_answer callback of the application module in question.
+%%
+%% Note that there's nothing stopping the request from being relayed
+%% back to the sender. A pick_peer callback may want to avoid this but
+%% a smart peer might recognize the potential loop and choose another
+%% route. A less smart one will probably just relay the request back
+%% again and force us to detect the loop. A pick_peer that wants to
+%% avoid this can specify filter to avoid the possibility.
+%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}.
%%
%% RFC 6.3 says that a relay agent does not modify Origin-Host but
%% says nothing about a proxy. Assume it should behave the same way.
-%% reply/3
+%% resend/4
%%
%% Relay a reply to a relayed request.
%% Answer from the peer: reset the hop by hop identifier and send.
-reply(#diameter_packet{bin = B}
- = Pkt,
- TPid,
- #diameter_packet{header = #diameter_header{hop_by_hop_id = Id},
- transport_data = TD}) ->
+resend(#diameter_packet{bin = B}
+ = Pkt,
+ _,
+ TPid,
+ #diameter_packet{header = #diameter_header{hop_by_hop_id = Id},
+ transport_data = TD}) ->
send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B),
transport_data = TD});
%% TODO: counters
-%% Not. Ignoring the error feels harsh but there is no appropriate
-%% Result-Code for a protocol error (which this isn't really anyway)
-%% and the RFC doesn't provide any guidance how to act. A weakness
-%% here is that we don't deal well with a decode error: the request
-%% will simply timeout on the peer's end. Better would be to just send
-%% the answer (with modified hop by hop identifier) on regardless, at
-%% least in the relay case in which there's no examination of the
-%% answer. In the proxy case it's not clear that the callback won't
-%% examine the answer. Just be quiet here since a decode error causes
-%% the request process to crash (or not depending on the error and
-%% config and/or handle_answer callback).
-reply(_, _, _) ->
- ok.
+%% Or not: DIAMETER_UNABLE_TO_DELIVER.
+resend(_, T, TPid, Pkt) ->
+ protocol_error(3002, T, TPid, Pkt).
%% is_loop/4
%%
@@ -1971,24 +1959,20 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) ->
%% make_reply_packet/2
+%% Binaries and header/avp lists are sent as-is.
make_reply_packet(Bin, _)
when is_binary(Bin) ->
#diameter_packet{bin = Bin};
-
make_reply_packet([#diameter_header{} | _] = Msg, _) ->
#diameter_packet{msg = Msg};
+%% Otherwise a reply message clears the R and T flags and retains the
+%% P flag. The E flag will be set at encode.
make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) ->
- #diameter_header{end_to_end_id = EId,
- hop_by_hop_id = Hid,
- is_proxiable = P}
- = ReqHdr,
-
- Hdr = #diameter_header{version = ?DIAMETER_VERSION,
- end_to_end_id = EId,
- hop_by_hop_id = Hid,
- is_proxiable = P,
- is_retransmitted = false},
+ Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
+ is_request = false,
+ is_error = undefined,
+ is_retransmitted = false},
#diameter_packet{header = Hdr,
msg = Msg}.
@@ -2126,16 +2110,6 @@ answer_message({OH, OR, RC}, Avps) ->
session_id(Code, Vid, Avps)
when is_list(Avps) ->
try
- {value, #diameter_avp{} = Avp} = find_avp(Code, Vid, Avps),
- Avp
- catch
- error: _ ->
- []
- end;
-
-session_id(Code, Vid, Avps)
- when is_list(Avps) ->
- try
{value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps),
[{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}]
catch
@@ -2482,6 +2456,7 @@ rpd(Pid, Alias, PDict) ->
%%%
%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}}
%%% | false
+%%% | {error, Reason}
%%% ---------------------------------------------------------------------------
%% Initial call, from an arbitrary process.
@@ -2540,28 +2515,18 @@ get_destination(Msg, Dict) ->
[str(get_avp_value(Dict, 'Destination-Realm', Msg)),
str(get_avp_value(Dict, 'Destination-Host', Msg))].
-%% TODO:
-%%
-%% Should add some way of specifying destination directly so that the
-%% only requirement is that the prepare_request callback returns
-%% something specific. (eg. {host, DH}; that is, let the caller specify.)
-%%
-%% Also, there is no longer any need to call get_destination at all in
-%% the default case.
-
-str(T)
- when T == undefined;
- T == [] ->
+%% This is not entirely correct. The avp could have an arity 1, in
+%% which case an empty list is a DiameterIdentity of length 0 rather
+%% than the list of no values we treat it as by mapping to undefined.
+%% This behaviour is documented.
+str([]) ->
undefined;
-str([X])
- when is_list(X) ->
- X;
str(T) ->
T.
%% get_avp_value/3
%%
-%% Support outgoing messages in one of three forms:
+%% Find an AVP in a message of one of three forms:
%%
%% - a message record (as generated from a .dia spec) or
%% - a list of an atom message name followed by 2-tuple, avp name/value pairs.
@@ -2593,8 +2558,9 @@ get_avp_value(_, Name, [_MsgName | Avps]) ->
undefined
end;
-get_avp_value(Dict, Name, Rec)
- when is_tuple(Rec) ->
+%% Message is typically a record but not necessarily: diameter:call/4
+%% can be passed an arbitrary term.
+get_avp_value(Dict, Name, Rec) ->
try
Dict:'#get-'(Name, Rec)
catch
@@ -2690,7 +2656,8 @@ peers(Alias, RH, Filter, Peers) ->
end.
%% Place a peer whose Destination-Host/Realm matches those of the
-%% request at the front of the result list.
+%% request at the front of the result list. Could add some sort of
+%% 'sort' option to allow more control.
ps([], _, _, {Ys, Ns}) ->
lists:reverse(Ys, Ns);
@@ -2700,11 +2667,11 @@ ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) ->
TC,
Acc)).
-pacc(true, true, TC, {Ts, Fs}) ->
- {[TC|Ts], Fs};
-pacc(true, false, TC, {Ts, Fs}) ->
- {Ts, [TC|Fs]};
-pacc(false, _, _, Acc) ->
+pacc(true, true, Peer, {Ts, Fs}) ->
+ {[Peer|Ts], Fs};
+pacc(true, false, Peer, {Ts, Fs}) ->
+ {Ts, [Peer|Fs]};
+pacc(_, _, _, Acc) ->
Acc.
%% caps_filter/3
@@ -2712,17 +2679,19 @@ pacc(false, _, _, Acc) ->
caps_filter(C, RH, {neg, F}) ->
not caps_filter(C, RH, F);
-caps_filter(C, RH, {all, L}) ->
+caps_filter(C, RH, {all, L})
+ when is_list(L) ->
lists:all(fun(F) -> caps_filter(C, RH, F) end, L);
-caps_filter(C, RH, {any, L}) ->
+caps_filter(C, RH, {any, L})
+ when is_list(L) ->
lists:any(fun(F) -> caps_filter(C, RH, F) end, L);
-caps_filter(#diameter_caps{origin_host = {_,H}}, [_,DH], host) ->
- eq(undefined, DH, H);
+caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) ->
+ eq(undefined, DH, OH);
-caps_filter(#diameter_caps{origin_realm = {_,R}}, [DR,_], realm) ->
- eq(undefined, DR, R);
+caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) ->
+ eq(undefined, DR, OR);
caps_filter(C, _, Filter) ->
caps_filter(C, Filter).
@@ -2738,6 +2707,9 @@ caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) ->
caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) ->
eq(any, R, OR);
+%% Anything else is expected to be an eval filter. Filter failure is
+%% documented as being equivalent to a non-matching filter.
+
caps_filter(C, T) ->
try
{eval, F} = T,
@@ -2746,8 +2718,14 @@ caps_filter(C, T) ->
_:_ -> false
end.
-eq(X, A, B) ->
- X == A orelse A == B.
+eq(Any, Id, PeerId) ->
+ Any == Id orelse try
+ iolist_to_binary(Id) == iolist_to_binary(PeerId)
+ catch
+ _:_ -> false
+ end.
+%% OctetString() can be specified as an iolist() so test for string
+%% rather then term equality.
%% transports/1
diff --git a/lib/diameter/src/app/diameter_stats.erl b/lib/diameter/src/app/diameter_stats.erl
index b52d4cdcfb..71479afa95 100644
--- a/lib/diameter/src/app/diameter_stats.erl
+++ b/lib/diameter/src/app/diameter_stats.erl
@@ -207,7 +207,7 @@ handle_call({flush, Contrib}, _From, State) ->
{reply, fetch(Contrib), State};
handle_call(Req, From, State) ->
- warning_msg("received unexpected request from ~p:~n~w", [From, Req]),
+ ?UNEXPECTED([Req, From]),
{reply, nok, State}.
%% ----------------------------------------------------------
@@ -219,7 +219,7 @@ handle_cast({incr, Rec}, State) ->
{noreply, State};
handle_cast(Msg, State) ->
- warning_msg("received unexpected message:~n~w", [Msg]),
+ ?UNEXPECTED([Msg]),
{noreply, State}.
%% ----------------------------------------------------------
@@ -231,7 +231,7 @@ handle_info({'DOWN', _MRef, process, Pid, _}, State) ->
{noreply, State};
handle_info(Info, State) ->
- warning_msg("received unknown info:~n~w", [Info]),
+ ?UNEXPECTED([Info]),
{noreply, State}.
%% ----------------------------------------------------------
@@ -340,8 +340,3 @@ cast(Msg) ->
call(Request) ->
gen_server:call(?SERVER, Request, infinity).
-
-%% warning_msg/2
-
-warning_msg(F, A) ->
- ?diameter_warning("~p: " ++ F, [?MODULE | A]).
diff --git a/lib/diameter/src/app/diameter_sync.erl b/lib/diameter/src/app/diameter_sync.erl
index f7777ae809..ce2db4b3a2 100644
--- a/lib/diameter/src/app/diameter_sync.erl
+++ b/lib/diameter/src/app/diameter_sync.erl
@@ -204,37 +204,37 @@ handle_call(?REQUEST(Type, Name, Req, Max, Timeout),
T = find(Name, QD),
nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State);
-handle_call(Request, _From, State) ->
- {reply, call(Request, State), State}.
+handle_call(Request, From, State) ->
+ {reply, call(Request, From, State), State}.
-%% call/2
+%% call/3
-call(?CARP(Name), #state{queue = QD}) ->
+call(?CARP(Name), _, #state{queue = QD}) ->
pcar(find(Name, QD));
-call(state, State) ->
+call(state, _, State) ->
State;
-call(uptime, #state{time = T}) ->
+call(uptime, _, #state{time = T}) ->
diameter_lib:now_diff(T);
-call({flush, Name}, #state{queue = QD}) ->
+call({flush, Name}, _, #state{queue = QD}) ->
cancel(find(Name, QD));
-call(pending, #state{pending = N}) ->
+call(pending, _, #state{pending = N}) ->
N;
-call({pending, Name}, #state{queue = QD}) ->
+call({pending, Name}, _, #state{queue = QD}) ->
queued(find(Name, QD));
-call(queues, #state{queue = QD}) ->
+call(queues, _, #state{queue = QD}) ->
fetch_keys(QD);
-call({pids, Name}, #state{queue = QD}) ->
+call({pids, Name}, _, #state{queue = QD}) ->
plist(find(Name, QD));
-call(Req, _State) -> %% ignore
- warning_msg("received unexpected request:~n~w", [Req]),
+call(Req, From, _State) -> %% ignore
+ ?UNEXPECTED(handle_call, [Req, From]),
nok.
%%% ----------------------------------------------------------
@@ -242,7 +242,7 @@ call(Req, _State) -> %% ignore
%%% ----------------------------------------------------------
handle_cast(Msg, State) ->
- warning_msg("received unexpected message:~n~w", [Msg]),
+ ?UNEXPECTED([Msg]),
{noreply, State}.
%%% ----------------------------------------------------------
@@ -267,7 +267,7 @@ info({'DOWN', MRef, process, Pid, Info},
queue = dq(fetch(Name, QD), Pid, Info, Name, QD)};
info(Info, State) ->
- warning_msg("received unknown info:~n~w", [Info]),
+ ?UNEXPECTED(handle_info, [Info]),
State.
reply({call, From}, T) ->
@@ -548,8 +548,3 @@ gen_call(Server, Req, Timeout) ->
exit: _ ->
timeout
end.
-
-%% warning_msg/2
-
-warning_msg(F, A) ->
- ?diameter_warning("~p: " ++ F, [?MODULE | A]).
diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl
index 30caebc544..a33b07a3d3 100644
--- a/lib/diameter/src/compiler/diameter_codegen.erl
+++ b/lib/diameter/src/compiler/diameter_codegen.erl
@@ -37,7 +37,6 @@
file/2,
file/3]).
--include_lib("diameter/src/app/diameter_internal.hrl").
-include("diameter_forms.hrl").
%% Generated functions that could have no generated clauses will have
diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore
new file mode 100644
index 0000000000..df38dfc5e3
--- /dev/null
+++ b/lib/diameter/test/.gitignore
@@ -0,0 +1,3 @@
+
+/log
+/depend.mk
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
index b3648c7bb1..64e200584f 100644
--- a/lib/diameter/test/Makefile
+++ b/lib/diameter/test/Makefile
@@ -16,41 +16,40 @@
#
# %CopyrightEnd%
-ifneq ($(ERL_TOP),)
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
+ifeq ($(ERL_TOP),)
+TOP = $(DIAMETER_TOP)
else
-include $(DIAMETER_TOP)/make/target.mk
-include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk
+TOP = $(ERL_TOP)
+DIAMETER_TOP = $(TOP)/lib/diameter
endif
+include $(TOP)/make/target.mk
+include $(TOP)/make/$(TARGET)/otp.mk
+
# ----------------------------------------------------
# Application version
# ----------------------------------------------------
+
include ../vsn.mk
-VSN=$(DIAMETER_VSN)
+VSN = $(DIAMETER_VSN)
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
+
RELSYSDIR = $(RELEASE_PATH)/diameter_test
ifeq ($(findstring win32,$(TARGET)),win32)
-
MAKEFILE_SRC = Makefile.win32.src
-
else
-
MAKEFILE_SRC = Makefile.src
-
endif
ifeq ($(TT_DIR),)
TT_DIR = /tmp
endif
-
# ----------------------------------------------------
# Target Specs
# ----------------------------------------------------
@@ -59,30 +58,17 @@ include modules.mk
EBIN = .
-HRL_FILES = diameter_test_lib.hrl
-
+HRL_FILES = $(INTERNAL_HRL_FILES)
ERL_FILES = $(MODULES:%=%.erl)
SOURCE = $(HRL_FILES) $(ERL_FILES)
-
TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-APP_CASES = app appup
-
-TRANSPORT_CASES = tcp
-
-ALL_CASES = \
- $(APP_CASES) \
- compiler conf sync session stats reg peer \
- $(TRANSPORT_CASES)
-
+SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES))
+SUITES = $(SUITE_MODULES:diameter_%_SUITE=%)
EMAKEFILE = Emakefile
-ifneq ($(ERL_TOP),)
-MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
-else
-MAKE_EMAKE = $(wildcard $(DIAMETER_TOP)/make/make_emakefile)
-endif
+MAKE_EMAKE = $(wildcard $(TOP)/make/make_emakefile)
ifeq ($(MAKE_EMAKE),)
BUILDTARGET = $(TARGET_FILES)
@@ -92,7 +78,6 @@ BUILDTARGET = emakebuild
RELTEST_FILES = $(EMAKEFILE) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE)
endif
-
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
@@ -107,291 +92,116 @@ ifeq ($(USE_DIAMETER_HIPE),true)
ERL_COMPILE_FLAGS += +native -DDIAMETER_hipe_special=true
endif
-ifneq ($(ERL_TOP),)
-ERL_COMPILE_FLAGS += \
- $(DIAMETER_ERL_COMPILE_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
- -I$(ERL_TOP)/lib/test_server/include
-else
-ERL_COMPILE_FLAGS += \
- $(DIAMETER_ERL_COMPILE_FLAGS) \
- -pa $(TEST_SERVER_DIR)/ebin \
- -I$(TEST_SERVER_DIR)/include
-endif
-
-ERL_PATH = \
- -pa ../../$(APPLICATION)/ebin \
- -pa ../../et/ebin
-
-ifndef SUITE
-SUITE = diameter_SUITE
-endif
-
-ESTOP = -s init stop
-
-ifeq ($(DONT_STOP),true)
-MAYBE_ESTOP =
-else
-MAYBE_ESTOP = $(ESTOP)
-endif
-
-ETVIEW = -s et_viewer
-ifeq ($(USE_ET_VIEWER),true)
-MAYBE_ETVIEW =
-else
-MAYBE_ETVIEW = $(ETVIEW)
-endif
-
-ifeq ($(MERL),)
-MERL = $(ERL)
-endif
-
-ARGS += -noshell
-
-ifeq ($(DISABLE_TC_TIMEOUT),true)
-ARGS += -diameter_test_timeout
-endif
-
-
-DIAMETER_TEST_SERVER = diameter_test_server
-
+ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \
+ -DDIAMETER_CT=true \
+ -I $(DIAMETER_TOP)/src/app
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-tests debug opt: $(BUILDTARGET)
+all test: $(SUITES)
-targets: $(TARGET_FILES)
+tests debug opt: $(BUILDTARGET)
-.PHONY: emakebuild
+beam targets: $(TARGET_FILES)
emakebuild: $(EMAKEFILE)
$(EMAKEFILE):
- $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' | grep -v Warning > $(EMAKEFILE)
- $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) | grep -v Warning >> $(EMAKEFILE)
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o $(EBIN) '*_SUITE_make' $(MODULES) \
+ | grep -v Warning \
+ > $(EMAKEFILE)
clean:
rm -f $(EMAKEFILE)
rm -f $(TARGET_FILES)
+ rm -f depend.mk
+
+realclean: clean
rm -f errs core *~
+.PHONY: all emakebuild test tests debug opt beam targets clean realclean
+
docs:
info:
- @echo "MAKE_EMAKE = $(MAKE_EMAKE)"
- @echo "EMAKEFILE = $(EMAKEFILE)"
- @echo "BUILDTARGET = $(BUILDTARGET)"
- @echo ""
+ @echo "MAKE_EMAKE = $(MAKE_EMAKE)"
+ @echo "EMAKEFILE = $(EMAKEFILE)"
+ @echo "BUILDTARGET = $(BUILDTARGET)"
+ @echo
@echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
@echo "ERL = $(ERL)"
@echo "ERLC = $(ERLC)"
- @echo "MERL = $(MERL)"
- @echo ""
- @echo "ARGS = $(ARGS)"
- @echo ""
+ @echo
@echo "HRL_FILES = $(HRL_FILES)"
@echo "ERL_FILES = $(ERL_FILES)"
@echo "TARGET_FILES = $(TARGET_FILES)"
- @echo ""
+ @echo
+ @echo "SUITE_MODULES = $(SUITE_MODULES)"
+ @echo "SUITES = $(SUITES)"
+ @echo
help:
- @echo ""
- @echo "This Makefile controls the test of the $(APPLICATION) application. "
- @echo ""
+ @echo
+ @echo "This Makefile controls the test of the $(APPLICATION) application."
+ @echo
@echo "There are two separate ways to perform the test of $(APPLICATION)."
- @echo ""
+ @echo
@echo " a) Run the official OTP test-server (which we do not describe here)"
- @echo ""
- @echo " b) Run the test-server provided with this application. "
- @echo " There are a number of targets to run the entire or parts"
- @echo " of this applications ($(APPLICATION)) test-suite"
- @echo ""
+ @echo
+ @echo " b) Run individual suites using targets in this makefile, target"
+ @echo " xxx running the testcases contained in $(APPLICATION)_xxx_SUITE."
+ @echo
@echo "Targets:"
- @echo ""
- @echo " help"
- @echo " Print this info"
- @echo ""
+ @echo
+ @echo " all"
+ @echo " Run all test suites."
+ @echo
+ @echo " $(SUITES)"
+ @echo " Run a specific test suite."
+ @echo
+ @echo " beam"
+ @echo " Compile all test-code."
+ @echo
+ @echo " clean"
+ @echo " Remove generated files."
+ @echo
@echo " info"
- @echo " Prints various environment variables. "
- @echo " May be useful when debugging the Makefile. "
- @echo ""
- @echo " tests | debug | opt "
- @echo " Compile all test-code. "
- @echo ""
- @echo " clean "
- @echo " Remove all targets. "
- @echo ""
- @echo " test"
- @echo " Run the entire $(APPLICATION) test-suite. "
- @echo ""
- @echo " app"
- @echo " Run the $(APPLICATION) application sub-test-suite. "
- @echo ""
- @echo " appup"
- @echo " Run the $(APPLICATION) application upgrade (appup) sub-test-suite. "
- @echo ""
- @echo " compiler"
- @echo " Run the $(APPLICATION) compiler sub-test-suite(s). "
- @echo ""
- @echo " conf"
- @echo " Run the $(APPLICATION) config sub-test-suite. "
- @echo " Checks various aspects of the $(APPLICATION) configuration. "
- @echo ""
- @echo " sync"
- @echo " Run the $(APPLICATION) sync sub-test-suite. "
- @echo ""
- @echo " session"
- @echo " Run the $(APPLICATION) session sub-test-suite. "
- @echo ""
- @echo " stats"
- @echo " Run the $(APPLICATION) stats sub-test-suite. "
- @echo ""
- @echo " reg"
- @echo " Run the $(APPLICATION) reg sub-test-suite. "
- @echo ""
- @echo " peer"
- @echo " Run the $(APPLICATION) peer sub-test-suite"
- @echo ""
- @echo " ptab"
- @echo " Run the $(APPLICATION) persistent-table sub-test-suite"
- @echo ""
- @echo " tcp"
- @echo " Run the $(APPLICATION) tcp sub-test-suite"
- @echo ""
- @echo ""
+ @echo " Prints various environment variables."
+ @echo " May be useful when debugging this Makefile."
+ @echo
+ @echo " help"
+ @echo " Print this info."
+ @echo
+.PHONY: docs info help
# ----------------------------------------------------
# Special Targets
# ----------------------------------------------------
-all: make
- @echo "make sure epmd is new"
- @epmd -kill > /dev/null
- @echo "Running all sub-suites separatelly"
- @for i in $(ALL_CASES); do \
- echo "SUITE: $$i"; \
- clearmake -V $$i > $$i.log; \
- done
-
-aall: make
- @echo "make sure epmd is new"
- @epmd -kill > /dev/null
- @echo "Running all app sub-suites separatelly"
- @for i in $(APP_CASES); do \
- echo "SUITE: $$i"; \
- clearmake -V $$i > $$i.log; \
- done
- echo "done"
-
-tall: make
- @echo "make sure epmd is new"
- @epmd -kill > /dev/null
- @echo "Running all transport sub-suites separatelly"
- @for i in $(TRANSPORT_CASES); do \
- echo "SUITE: $$i"; \
- clearmake -V $$i > $$i.log; \
- done
-
-make: targets
-
-test: make
- $(MERL) $(ARGS) -sname diameter_test $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
- $(MAYBE_ESTOP)
-
-utest: make
- $(MERL) $(ARGS) -sname diameter_utest $(ERL_PATH) \
- $(MAYBE_ETVIEW) \
- -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
- $(ESTOP)
-
-# ftest: make
-# $(MERL) $(ARGS) -sname diameter_ftest $(ERL_PATH) \
-# -s diameter_filter \
-# -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
-# $(ESTOP)
-#
-
-##########################
-
-# tickets: make
-# $(MERL) $(ARGS) -sname diameter_tickets $(ERL_PATH) \
-# -s $(DIAMETER_TEST_SERVER) tickets $(SUITE) \
-# $(ESTOP)
-#
-
-app: make
- $(MERL) $(ARGS) -sname diameter_app $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_app_test \
- $(ESTOP)
-
-appup: make
- $(MERL) $(ARGS) -sname diameter_appup $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_appup_test \
- $(ESTOP)
-
-compiler: make
- $(MERL) $(ARGS) -sname diameter_compiler $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_compiler_test \
- $(ESTOP)
-
-conf: make
- $(MERL) $(ARGS) -sname diameter_config $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_config_test \
- $(ESTOP)
-
-sync: make
- $(MERL) $(ARGS) -sname diameter_sync $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_sync_test \
- $(ESTOP)
+# Exit with a non-zero status if the output looks to indicate failure.
+# diameter_ct:run/1 itself can't tell (it seems).
+$(SUITES): log targets
+ $(ERL) -noshell \
+ -pa $(DIAMETER_TOP)/ebin \
+ -sname diameter_test_$@ \
+ -s diameter_ct run diameter_$@_SUITE \
+ -s init stop \
+ | awk '1{rc=0} {print} / FAILED /{rc=1} END{exit rc}'
+# Shorter in sed but requires a GNU extension (ie. Q).
-session: make
- $(MERL) $(ARGS) -sname diameter_session $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_session_test \
- $(ESTOP)
-
-stats: make
- $(MERL) $(ARGS) -sname diameter_stats $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_stats_test \
- $(ESTOP)
-
-reg: make
- $(MERL) $(ARGS) -sname diameter_reg $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_reg_test \
- $(ESTOP)
-
-peer: make
- $(MERL) $(ARGS) -sname diameter_peer $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_peer_test \
- $(ESTOP)
-
-ptab: make
- $(MERL) $(ARGS) -sname diameter_persistent_table $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_persistent_table_test \
- $(ESTOP)
-
-tcp: make
- $(MERL) $(ARGS) -sname diameter_tcp $(ERL_PATH) \
- -s $(DIAMETER_TEST_SERVER) t diameter_tcp_test \
- $(ESTOP)
-
-
-node:
- $(MERL) -sname diameter $(ERL_PATH)
+log:
+ mkdir $@
+.PHONY: $(SUITES)
# ----------------------------------------------------
# Release Targets
# ----------------------------------------------------
-ifneq ($(ERL_TOP),)
-include $(ERL_TOP)/make/otp_release_targets.mk
-else
-include $(DIAMETER_TOP)/make/release_targets.mk
-endif
+include $(TOP)/make/otp_release_targets.mk
release_spec:
@@ -400,9 +210,20 @@ release_docs_spec:
release_tests_spec: tests
$(INSTALL_DIR) $(RELSYSDIR)
$(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR)
-# $(INSTALL_DATA) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) \
-# $(HRL_FILES) $(ERL_FILES) \
-# $(RELSYSDIR)
-#
- chmod -R u+w $(RELSYSDIR)
+.PHONY: release_spec release_docs_spec release_test_specs
+
+# ----------------------------------------------------
+
+depend: depend.mk
+
+# Generate dependencies makefile.
+depend.mk: depend.sed $(MODULES:%=%.erl) Makefile
+ (for f in $(MODULES); do \
+ sed -f $< $$f.erl | sed "s@/@/$$f@"; \
+ done) \
+ > $@
+
+-include depend.mk
+
+.PHONY: depend
diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed
new file mode 100644
index 0000000000..a399eb45f0
--- /dev/null
+++ b/lib/diameter/test/depend.sed
@@ -0,0 +1,31 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2010-2011. 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
+# 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 online 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.
+#
+# %CopyrightEnd%
+#
+
+#
+# Extract local include dependencies from .erl files. The output is massaged
+# further in Makefile.
+#
+
+/^-include/!d
+/^-include_lib/d
+/diameter_gen/d
+
+s@^-include("@@
+s@".*@@
+s@^@$(EBIN)/.$(EMULATOR): @
diff --git a/lib/diameter/test/diameter.spec b/lib/diameter/test/diameter.spec
index a6e71762eb..fae7863bec 100644
--- a/lib/diameter/test/diameter.spec
+++ b/lib/diameter/test/diameter.spec
@@ -1,9 +1 @@
{suites, "../diameter_test", all}.
-%%{skip, {diameter_compiler_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_config_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_peer_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_reg_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_session_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_stats_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_sync_test, all, "Not yet implemented"}}.
-%%{skip, {diameter_tcp_test, all, "Not yet implemented"}}.
diff --git a/lib/diameter/test/diameter_SUITE.erl b/lib/diameter/test/diameter_SUITE.erl
deleted file mode 100644
index 443cf90e92..0000000000
--- a/lib/diameter/test/diameter_SUITE.erl
+++ /dev/null
@@ -1,108 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Test application config
-%%----------------------------------------------------------------------
-
--module(diameter_SUITE).
-
--export([
- suite/0,
- all/0,
- groups/0,
-
- init_per_testcase/2,
- fin_per_testcase/2,
-
- init_per_suite/1,
- end_per_suite/1,
-
- init_per_group/2,
- end_per_group/2,
-
- init/0
- ]).
-
--export([t/0, t/1]).
-
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-init() ->
- process_flag(trap_exit, true),
- ?FLUSH().
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Top test case
-
-suite() ->
- [{ct_hooks, [{ts_install_cth, [{nodenames,1}]}]}].
-
-all() ->
- [
- {group, app},
- {group, appup},
- {group, compiler},
- {group, config},
- {group, sync},
- {group, session},
- {group, stats},
- {group, reg},
- {group, peer},
- {group, tcp}
- ].
-
-groups() ->
- [{app, [], [{diameter_app_test, all}]},
- {appup, [], [{diameter_appup_test, all}]},
- {compiler, [], [{diameter_compiler_test, all}]},
- {config, [], [{diameter_config_test, all}]},
- {sync, [], [{diameter_sync_test, all}]},
- {session, [], [{diameter_session_test, all}]},
- {stats, [], [{diameter_stats_test, all}]},
- {reg, [], [{diameter_reg_test, all}]},
- {peer, [], [{diameter_peer_test, all}]},
- {tcp, [], [{diameter_tcp_test, all}]}].
-
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
new file mode 100644
index 0000000000..d710fa155d
--- /dev/null
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -0,0 +1,249 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests based on the contents of the diameter app file.
+%%
+
+-module(diameter_app_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([keys/1,
+ vsn/1,
+ modules/1,
+ exports/1,
+ release/1,
+ xref/1,
+ relup/1]).
+
+-include("diameter_ct.hrl").
+
+-define(A, list_to_atom).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [keys,
+ vsn,
+ modules,
+ exports,
+ release,
+ xref,
+ relup].
+
+init_per_suite(Config) ->
+ [{application, ?APP, App}] = diameter_util:consult(?APP, app),
+ [{app, App} | Config].
+
+end_per_suite(_Config) ->
+ ok.
+
+%% ===========================================================================
+%% # keys/1
+%%
+%% Ensure that the app file contains selected keys. Some of these would
+%% also be caught by other testcases.
+%% ===========================================================================
+
+keys(Config) ->
+ App = fetch(app, Config),
+ [] = lists:filter(fun(K) -> not lists:keymember(K, 1, App) end,
+ [vsn, description, modules, registered, applications]).
+
+%% ===========================================================================
+%% # vsn/1
+%%
+%% Ensure that our app version sticks to convention.
+%% ===========================================================================
+
+vsn(Config) ->
+ true = is_vsn(fetch(vsn, fetch(app, Config))).
+
+%% ===========================================================================
+%% # modules/1
+%%
+%% Ensure that the app file module list match the installed beams.
+%% ===========================================================================
+
+modules(Config) ->
+ Mods = fetch(modules, fetch(app, Config)),
+ Installed = code_mods(),
+ {[], []} = {Mods -- Installed, Installed -- Mods}.
+
+code_mods() ->
+ Dir = code:lib_dir(?APP, ebin),
+ {ok, Files} = file:list_dir(Dir),
+ [?A(lists:reverse(R)) || N <- Files, "maeb." ++ R <- [lists:reverse(N)]].
+
+%% ===========================================================================
+%% # exports/1
+%%
+%% Ensure that no module does export_all.
+%% ===========================================================================
+
+exports(Config) ->
+ Mods = fetch(modules, fetch(app, Config)),
+ [] = [M || M <- Mods, exports_all(M)].
+
+exports_all(Mod) ->
+ Opts = fetch(options, Mod:module_info(compile)),
+
+ is_list(Opts) andalso lists:member(export_all, Opts).
+
+%% ===========================================================================
+%% # release/1
+%%
+%% Ensure that it's possible to build a minimal release with our app file.
+%% ===========================================================================
+
+release(Config) ->
+ App = fetch(app, Config),
+ Rel = {release,
+ {"diameter test release", fetch(vsn, App)},
+ {erts, erlang:system_info(version)},
+ [{A, appvsn(A)} || A <- fetch(applications, App)]},
+ Dir = fetch(priv_dir, Config),
+ ok = write_file(filename:join([Dir, "diameter_test.rel"]), Rel),
+ {ok, _, []} = systools:make_script("diameter_test", [{path, [Dir]},
+ {outdir, Dir},
+ silent]).
+
+appvsn(Name) ->
+ [{application, Name, App}] = diameter_util:consult(Name, app),
+ fetch(vsn, App).
+
+%% ===========================================================================
+%% # xref/1
+%%
+%% Ensure that no function in our application calls an undefined function.
+%% ===========================================================================
+
+xref(Config) ->
+ App = fetch(app, Config),
+ Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg],
+ %% Skip modules that aren't required at runtime and that have
+ %% dependencies beyond those applications listed in the app file.
+
+ {ok, XRef} = xref:start(make_name(xref_test_name)),
+ ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]),
+
+ %% Only add our application and those it's dependent on according
+ %% to the app file. Well, almost. erts beams are also required to
+ %% stop xref from complaining about calls to module erlang, which
+ %% was previously in kernel. Erts isn't an application however, in
+ %% the sense that there's no .app file, and isn't listed in
+ %% applications. Seems less than ideal.
+ ok = lists:foreach(fun(A) -> add_application(XRef, A) end,
+ [?APP, erts | fetch(applications, App)]),
+
+ {ok, Undefs} = xref:analyze(XRef, undefined_function_calls),
+
+ xref:stop(XRef),
+
+ %% Only care about calls from our own application.
+ [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs).
+
+add_application(XRef, App) ->
+ add_application(XRef, App, code:lib_dir(App)).
+
+%% erts will not be in the lib directory before installation.
+add_application(XRef, erts, {error, _}) ->
+ Dir = filename:join([code:root_dir(), "erts", "preloaded", "ebin"]),
+ {ok, _} = xref:add_directory(XRef, Dir, []);
+add_application(XRef, App, Dir)
+ when is_list(Dir) ->
+ {ok, App} = xref:add_application(XRef, Dir, []).
+
+make_name(Suf) ->
+ list_to_atom(atom_to_list(?APP) ++ "_" ++ atom_to_list(Suf)).
+
+%% ===========================================================================
+%% # relup/1
+%%
+%% Ensure that we can generate release upgrade files using our appup file.
+%% ===========================================================================
+
+relup(Config) ->
+ [{Vsn, Up, Down}] = diameter_util:consult(?APP, appup),
+ true = is_vsn(Vsn),
+
+ App = fetch(app, Config),
+ Rel = [{erts, erlang:system_info(version)}
+ | [{A, appvsn(A)} || A <- fetch(applications, App)]],
+
+ Dir = fetch(priv_dir, Config),
+
+ Name = write_rel(Dir, Rel, Vsn),
+ UpFrom = acc_rel(Dir, Rel, Up),
+ DownTo = acc_rel(Dir, Rel, Down),
+
+ {[Name], [Name], UpFrom, DownTo} %% no intersections
+ = {[Name] -- UpFrom,
+ [Name] -- DownTo,
+ UpFrom -- DownTo,
+ DownTo -- UpFrom},
+
+ {ok, _, _, []} = systools:make_relup(Name, UpFrom, DownTo, [{path, [Dir]},
+ {outdir, Dir},
+ silent]).
+
+acc_rel(Dir, Rel, List) ->
+ lists:foldl(fun(T,A) -> acc_rel(Dir, Rel, T, A) end,
+ [],
+ List).
+
+acc_rel(Dir, Rel, {Vsn, _}, Acc) ->
+ [write_rel(Dir, Rel, Vsn) | Acc].
+
+%% Write a rel file and return its name.
+write_rel(Dir, [Erts | Apps], Vsn) ->
+ true = is_vsn(Vsn),
+ Name = "diameter_test_" ++ Vsn,
+ ok = write_file(filename:join([Dir, Name ++ ".rel"]),
+ {release,
+ {"diameter " ++ Vsn ++ " test release", Vsn},
+ Erts,
+ Apps}),
+ Name.
+
+%% ===========================================================================
+%% ===========================================================================
+
+fetch(Key, List) ->
+ {Key, {Key, Val}} = {Key, lists:keyfind(Key, 1, List)}, %% useful badmatch
+ Val.
+
+write_file(Path, T) ->
+ file:write_file(Path, io_lib:format("~p.", [T])).
+
+%% Is a version string of the expected form? Return the argument
+%% itself for 'false' for a useful badmatch.
+is_vsn(V) ->
+ is_list(V)
+ andalso length(V) == string:span(V, "0123456789.")
+ andalso V == string:join(string:tokens(V, [$.]), ".") %% no ".."
+ orelse {error, V}.
diff --git a/lib/diameter/test/diameter_app_test.erl b/lib/diameter/test/diameter_app_test.erl
deleted file mode 100644
index 7173c39caf..0000000000
--- a/lib/diameter/test/diameter_app_test.erl
+++ /dev/null
@@ -1,393 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the application specifics of the Diameter application
-%%----------------------------------------------------------------------
--module(diameter_app_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2,
-
- fields/1,
- modules/1,
- exportall/1,
- app_depend/1,
- undef_funcs/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(undef_funcs = Case, Config) ->
- NewConfig = [{tc_timeout, ?MINUTES(10)} | Config],
- diameter_test_server:init_per_testcase(Case, NewConfig);
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [
- fields,
- modules,
- exportall,
- app_depend,
- undef_funcs
- ].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- io:format("~w:init_per_suite -> entry with"
- "~n Config: ~p"
- "~n", [?MODULE, Config]),
- case is_app(diameter) of
- {ok, AppFile} ->
- io:format("AppFile: ~n~p~n", [AppFile]),
- %% diameter:print_version_info(),
- [{app_file, AppFile}|Config];
- {error, Reason} ->
- ?FAIL(Reason)
- end.
-
-is_app(App) ->
- LibDir = code:lib_dir(App),
- File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]),
- case file:consult(File) of
- {ok, [{application, App, AppFile}]} ->
- {ok, AppFile};
- Error ->
- {error, {invalid_format, Error}}
- end.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fields(suite) ->
- [];
-fields(doc) ->
- [];
-fields(Config) when is_list(Config) ->
- AppFile = ?KEY1SEARCH(app_file, Config),
- Fields = [vsn, description, modules, registered, applications],
- case check_fields(Fields, AppFile, []) of
- [] ->
- ok;
- Missing ->
- ?FAIL({missing_fields, Missing})
- end.
-
-check_fields([], _AppFile, Missing) ->
- Missing;
-check_fields([Field|Fields], AppFile, Missing) ->
- check_fields(Fields, AppFile, check_field(Field, AppFile, Missing)).
-
-check_field(Name, AppFile, Missing) ->
- io:format("checking field: ~p~n", [Name]),
- case lists:keymember(Name, 1, AppFile) of
- true ->
- Missing;
- false ->
- [Name|Missing]
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-modules(suite) ->
- [];
-modules(doc) ->
- [];
-modules(Config) when is_list(Config) ->
- AppFile = ?KEY1SEARCH(app_file, Config),
- Mods = ?KEY1SEARCH(modules, AppFile),
- EbinList = get_ebin_mods(diameter),
- case missing_modules(Mods, EbinList, []) of
- [] ->
- ok;
- Missing ->
- throw({error, {missing_modules, Missing}})
- end,
- Allowed = [diameter_codegen,
- diameter_make,
- diameter_spec_scan,
- diameter_spec_util],
- case extra_modules(Mods, EbinList, Allowed, []) of
- [] ->
- ok;
- Extra ->
- throw({error, {extra_modules, Extra}})
- end,
- {ok, Mods}.
-
-get_ebin_mods(App) ->
- LibDir = code:lib_dir(App),
- EbinDir = filename:join([LibDir,"ebin"]),
- {ok, Files0} = file:list_dir(EbinDir),
- Files1 = [lists:reverse(File) || File <- Files0],
- [list_to_atom(lists:reverse(Name)) || [$m,$a,$e,$b,$.|Name] <- Files1].
-
-
-missing_modules([], _Ebins, Missing) ->
- Missing;
-missing_modules([Mod|Mods], Ebins, Missing) ->
- case lists:member(Mod, Ebins) of
- true ->
- missing_modules(Mods, Ebins, Missing);
- false ->
- io:format("missing module: ~p~n", [Mod]),
- missing_modules(Mods, Ebins, [Mod|Missing])
- end.
-
-
-extra_modules(_Mods, [], Allowed, Extra) ->
- Extra--Allowed;
-extra_modules(Mods, [Mod|Ebins], Allowed, Extra) ->
- case lists:member(Mod, Mods) of
- true ->
- extra_modules(Mods, Ebins, Allowed, Extra);
- false ->
- io:format("supefluous module: ~p~n", [Mod]),
- extra_modules(Mods, Ebins, Allowed, [Mod|Extra])
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-exportall(suite) ->
- [];
-exportall(doc) ->
- [];
-exportall(Config) when is_list(Config) ->
- AppFile = ?KEY1SEARCH(app_file, Config),
- Mods = ?KEY1SEARCH(modules, AppFile),
- check_export_all(Mods).
-
-
-check_export_all([]) ->
- ok;
-check_export_all([Mod|Mods]) ->
- case (catch apply(Mod, module_info, [compile])) of
- {'EXIT', {undef, _}} ->
- check_export_all(Mods);
- O ->
- case lists:keysearch(options, 1, O) of
- false ->
- check_export_all(Mods);
- {value, {options, List}} ->
- case lists:member(export_all, List) of
- true ->
- throw({error, {export_all, Mod}});
- false ->
- check_export_all(Mods)
- end
- end
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-app_depend(suite) ->
- [];
-app_depend(doc) ->
- [];
-app_depend(Config) when is_list(Config) ->
- AppFile = ?KEY1SEARCH(app_file, Config),
- Apps = ?KEY1SEARCH(applications, AppFile),
- check_apps(Apps).
-
-
-check_apps([]) ->
- ok;
-check_apps([App|Apps]) ->
- case is_app(App) of
- {ok, _} ->
- check_apps(Apps);
- Error ->
- throw({error, {missing_app, {App, Error}}})
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-undef_funcs(suite) ->
- [];
-undef_funcs(doc) ->
- [];
-undef_funcs(Config) when is_list(Config) ->
- ?SKIP(diameter_not_known_by_xref),
- App = diameter,
- AppFile = ?KEY1SEARCH(app_file, Config),
- Mods = ?KEY1SEARCH(modules, AppFile),
- Root = code:root_dir(),
- LibDir = code:lib_dir(App),
- EbinDir = filename:join([LibDir,"ebin"]),
- XRefTestName = undef_funcs_make_name(App, xref_test_name),
- try
- begin
- XRef = xref_start(XRefTestName),
- xref_set_defaults(XRef, [{verbose,false},{warnings,false}]),
- XRefName = undef_funcs_make_name(App, xref_name),
- XRefName = xref_add_release(XRef, Root, XRefName),
- xref_replace_application(XRef, App, EbinDir),
- Undefs = xref_analyze(XRef),
- xref_stop(XRef),
- analyze_undefined_function_calls(Undefs, Mods, [])
- end
- catch
- throw:{error, Reason} ->
- ?FAIL(Reason)
- end.
-
-
-xref_start(XRefTestName) ->
- case (catch xref:start(XRefTestName)) of
- {ok, XRef} ->
- XRef;
- {error, Reason} ->
- throw({error, {failed_starting_xref, Reason}});
- Error ->
- throw({error, {failed_starting_xref, Error}})
- end.
-
-xref_set_defaults(XRef, Defs) ->
- case (catch xref:set_default(XRef, Defs)) of
- ok ->
- ok;
- Error ->
- throw({error, {failed_setting_defaults, Defs, Error}})
- end.
-
-xref_add_release(XRef, Root, Name) ->
- case (catch xref:add_release(XRef, Root, {name, Name})) of
- {ok, XRefName} ->
- XRefName;
- {error, Reason} ->
- throw({error, {failed_adding_release, Reason}});
- Error ->
- throw({error, {failed_adding_release, Error}})
- end.
-
-xref_replace_application(XRef, App, EbinDir) ->
- case (catch xref:replace_application(XRef, App, EbinDir)) of
- {ok, App} ->
- ok;
- {error, XRefMod, Reason} ->
- throw({error, {failed_replacing_app, XRefMod, Reason}});
- Error ->
- throw({error, {failed_replacing_app, Error}})
- end.
-
-xref_analyze(XRef) ->
- case (catch xref:analyze(XRef, undefined_function_calls)) of
- {ok, Undefs} ->
- Undefs;
- {error, Reason} ->
- throw({error, {failed_detecting_func_calls, Reason}});
- Error ->
- throw({error, {failed_detecting_func_calls, Error}})
- end.
-
-xref_stop(XRef) ->
- xref:stop(XRef).
-
-analyze_undefined_function_calls([], _, []) ->
- ok;
-analyze_undefined_function_calls([], _, AppUndefs) ->
- exit({suite_failed, {undefined_function_calls, AppUndefs}});
-analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs],
- AppModules, AppUndefs) ->
- %% Check that this module is our's
- case lists:member(Mod,AppModules) of
- true ->
- {Calling,Called} = AppUndef,
- {Mod1,Func1,Ar1} = Calling,
- {Mod2,Func2,Ar2} = Called,
- io:format("undefined function call: "
- "~n ~w:~w/~w calls ~w:~w/~w~n",
- [Mod1,Func1,Ar1,Mod2,Func2,Ar2]),
- analyze_undefined_function_calls(Undefs, AppModules,
- [AppUndef|AppUndefs]);
- false ->
- io:format("dropping ~p~n", [Mod]),
- analyze_undefined_function_calls(Undefs, AppModules, AppUndefs)
- end.
-
-%% This function is used simply to avoid cut-and-paste errors later...
-undef_funcs_make_name(App, PostFix) ->
- list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-%% fail(Reason) ->
-%% exit({suite_failed, Reason}).
-
-%% ?KEY1SEARCH(Key, L) ->
-%% case lists:keysearch(Key, 1, L) of
-%% undefined ->
-%% fail({not_found, Key, L});
-%% {value, {Key, Value}} ->
-%% Value
-%% end.
diff --git a/lib/diameter/test/diameter_appup_test.erl b/lib/diameter/test/diameter_appup_test.erl
deleted file mode 100644
index 97a089e01a..0000000000
--- a/lib/diameter/test/diameter_appup_test.erl
+++ /dev/null
@@ -1,539 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the application specifics of the Diameter application
-%%----------------------------------------------------------------------
--module(diameter_appup_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2,
-
- appup/1
- ]).
-
--export([t/0, t/1]).
-
--compile({no_auto_import,[error/1]}).
-
--include("diameter_test_lib.hrl").
-
--define(APPLICATION, diameter).
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [appup].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- AppFile = file_name(?APPLICATION, ".app"),
- AppupFile = file_name(?APPLICATION, ".appup"),
- [{app_file, AppFile}, {appup_file, AppupFile}|Config].
-
-
-file_name(App, Ext) ->
- LibDir = code:lib_dir(App),
- filename:join([LibDir, "ebin", atom_to_list(App) ++ Ext]).
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-appup(suite) ->
- [];
-appup(doc) ->
- "perform a simple check of the appup file";
-appup(Config) when is_list(Config) ->
- AppupFile = key1search(appup_file, Config),
- AppFile = key1search(app_file, Config),
- Modules = modules(AppFile),
- check_appup(AppupFile, Modules).
-
-modules(File) ->
- case file:consult(File) of
- {ok, [{application,diameter,Info}]} ->
- case lists:keysearch(modules,1,Info) of
- {value, {modules, Modules}} ->
- Modules;
- false ->
- fail({bad_appinfo, Info})
- end;
- Error ->
- fail({bad_appfile, Error})
- end.
-
-
-check_appup(AppupFile, Modules) ->
- case file:consult(AppupFile) of
- {ok, [{V, UpFrom, DownTo}]} ->
- check_appup(V, UpFrom, DownTo, Modules);
- Else ->
- fail({bad_appupfile, Else})
- end.
-
-
-check_appup(V, UpFrom, DownTo, Modules) ->
- check_version(V),
- check_depends(up, UpFrom, Modules),
- check_depends(down, DownTo, Modules),
- check_module_subset(UpFrom),
- check_module_subset(DownTo),
- ok.
-
-
-check_depends(_, [], _) ->
- ok;
-check_depends(UpDown, [Dep|Deps], Modules) ->
- check_depend(UpDown, Dep, Modules),
- check_depends(UpDown, Deps, Modules).
-
-
-check_depend(up = UpDown, {add_application, ?APPLICATION} = Instr, Modules) ->
- d("check_instructions(~w) -> entry with"
- "~n Instruction: ~p"
- "~n Modules: ~p", [UpDown, Instr, Modules]),
- ok;
-check_depend(down = UpDown, {remove_application, ?APPLICATION} = Instr,
- Modules) ->
- d("check_instructions(~w) -> entry with"
- "~n Instruction: ~p"
- "~n Modules: ~p", [UpDown, Instr, Modules]),
- ok;
-check_depend(UpDown, {V, Instructions}, Modules) ->
- d("check_instructions(~w) -> entry with"
- "~n V: ~p"
- "~n Modules: ~p", [UpDown, V, Modules]),
- check_version(V),
- case check_instructions(UpDown,
- Instructions, Instructions, [], [], Modules) of
- {_Good, []} ->
- ok;
- {_, Bad} ->
- fail({bad_instructions, Bad, UpDown})
- end.
-
-
-check_instructions(_, [], _, Good, Bad, _) ->
- {lists:reverse(Good), lists:reverse(Bad)};
-check_instructions(UpDown, [Instr|Instrs], AllInstr, Good, Bad, Modules) ->
- d("check_instructions(~w) -> entry with"
- "~n Instr: ~p", [UpDown,Instr]),
- case (catch check_instruction(UpDown, Instr, AllInstr, Modules)) of
- ok ->
- check_instructions(UpDown, Instrs, AllInstr,
- [Instr|Good], Bad, Modules);
- {error, Reason} ->
- d("check_instructions(~w) -> bad instruction: "
- "~n Reason: ~p", [UpDown,Reason]),
- check_instructions(UpDown, Instrs, AllInstr, Good,
- [{Instr, Reason}|Bad], Modules)
- end.
-
-%% A new module is added
-check_instruction(up, {add_module, Module}, _, Modules)
- when is_atom(Module) ->
- d("check_instruction -> entry when up-add_module instruction with"
- "~n Module: ~p", [Module]),
- check_module(Module, Modules);
-
-%% An old module is re-added
-check_instruction(down, {add_module, Module}, _, Modules)
- when is_atom(Module) ->
- d("check_instruction -> entry when down-add_module instruction with"
- "~n Module: ~p", [Module]),
- case (catch check_module(Module, Modules)) of
- {error, {unknown_module, Module, Modules}} ->
- ok;
- ok ->
- error({existing_readded_module, Module})
- end;
-
-%% Removing a module on upgrade:
-%% - the module has been removed from the app-file.
-%% - check that no module depends on this (removed) module
-check_instruction(up, {remove, {Module, Pre, Post}}, _, Modules)
- when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) ->
- d("check_instruction -> entry when up-remove instruction with"
- "~n Module: ~p"
- "~n Pre: ~p"
- "~n Post: ~p", [Module, Pre, Post]),
- case (catch check_module(Module, Modules)) of
- {error, {unknown_module, Module, Modules}} ->
- check_purge(Pre),
- check_purge(Post);
- ok ->
- error({existing_removed_module, Module})
- end;
-
-%% Removing a module on downgrade: the module exist
-%% in the app-file.
-check_instruction(down, {remove, {Module, Pre, Post}}, AllInstr, Modules)
- when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) ->
- d("check_instruction -> entry when down-remove instruction with"
- "~n Module: ~p"
- "~n Pre: ~p"
- "~n Post: ~p", [Module, Pre, Post]),
- case (catch check_module(Module, Modules)) of
- ok ->
- check_purge(Pre),
- check_purge(Post),
- check_no_remove_depends(Module, AllInstr);
- {error, {unknown_module, Module, Modules}} ->
- error({nonexisting_removed_module, Module})
- end;
-
-check_instruction(_, {load_module, Module, Pre, Post, Depend},
- AllInstr, Modules)
- when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) ->
- d("check_instruction -> entry when load_module instruction with"
- "~n Module: ~p"
- "~n Pre: ~p"
- "~n Post: ~p"
- "~n Depend: ~p", [Module, Pre, Post, Depend]),
- check_module(Module, Modules),
- check_module_depend(Module, Depend, Modules),
- check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
- check_purge(Pre),
- check_purge(Post);
-
-check_instruction(_, {update, Module, Change, Pre, Post, Depend},
- AllInstr, Modules)
- when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) ->
- d("check_instruction -> entry when update instruction with"
- "~n Module: ~p"
- "~n Change: ~p"
- "~n Pre: ~p"
- "~n Post: ~p"
- "~n Depend: ~p", [Module, Change, Pre, Post, Depend]),
- check_module(Module, Modules),
- check_module_depend(Module, Depend, Modules),
- check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
- check_change(Change),
- check_purge(Pre),
- check_purge(Post);
-
-check_instruction(_, {update, Module, supervisor}, _, Modules)
- when is_atom(Module) ->
- check_module(Module, Modules);
-
-check_instruction(_, {apply, {Module, Function, Args}}, _, Modules)
- when is_atom(Module) andalso is_atom(Function) andalso is_list(Args) ->
- d("check_instruction -> entry when down-apply instruction with"
- "~n Module: ~p"
- "~n Function: ~p"
- "~n Args: ~p", [Module, Function, Args]),
- check_module(Module, Modules),
- check_apply(Module, Function, Args);
-
-check_instruction(_, {restart_application, ?APPLICATION}, _AllInstr, _Modules) ->
- ok;
-
-check_instruction(_, Instr, _AllInstr, _Modules) ->
- d("check_instruction -> entry when unknown instruction with"
- "~n Instr: ~p", [Instr]),
- error({error, {unknown_instruction, Instr}}).
-
-
-%% If Module X depends on Module Y, then module Y must have an update
-%% instruction of some sort (otherwise the depend is faulty).
-updated_modules([], Modules) ->
- d("update_modules -> entry when done with"
- "~n Modules: ~p", [Modules]),
- Modules;
-updated_modules([Instr|Instrs], Modules) ->
- d("update_modules -> entry with"
- "~n Instr: ~p"
- "~n Modules: ~p", [Instr,Modules]),
- Module = instruction_module(Instr),
- d("update_modules -> Module: ~p", [Module]),
- updated_modules(Instrs, [Module|Modules]).
-
-instruction_module({add_module, Module}) ->
- Module;
-instruction_module({remove, {Module, _, _}}) ->
- Module;
-instruction_module({load_module, Module, _, _, _}) ->
- Module;
-instruction_module({update, Module, _, _, _, _}) ->
- Module;
-instruction_module({apply, {Module, _, _}}) ->
- Module;
-instruction_module(Instr) ->
- d("instruction_module -> entry when unknown instruction with"
- "~n Instr: ~p", [Instr]),
- error({error, {unknown_instruction, Instr}}).
-
-
-%% Check that the modules handled in an instruction set for version X
-%% is a subset of the instruction set for version X-1.
-check_module_subset(Instructions) ->
- do_check_module_subset(modules_of(Instructions)).
-
-do_check_module_subset([]) ->
- ok;
-do_check_module_subset([_]) ->
- ok;
-do_check_module_subset([{_V1, Mods1}|T]) ->
- {V2, Mods2} = hd(T),
- %% Check that the modules in V1 is a subset of V2
- case do_check_module_subset2(Mods1, Mods2) of
- ok ->
- do_check_module_subset(T);
- {error, Modules} ->
- fail({subset_missing_instructions, V2, Modules})
- end.
-
-do_check_module_subset2(Mods1, Mods2) ->
- do_check_module_subset2(Mods1, Mods2, []).
-
-do_check_module_subset2([], _, []) ->
- ok;
-do_check_module_subset2([], _, Acc) ->
- {error, lists:reverse(Acc)};
-do_check_module_subset2([Mod|Mods], Mods2, Acc) ->
- case lists:member(Mod, Mods2) of
- true ->
- do_check_module_subset2(Mods, Mods2, Acc);
- false ->
- do_check_module_subset2(Mods, Mods2, [Mod|Acc])
- end.
-
-
-modules_of(Instructions) ->
- modules_of(Instructions, []).
-
-modules_of([], Acc) ->
- lists:reverse(Acc);
-modules_of([{V,Instructions}|T], Acc) ->
- Mods = modules_of2(Instructions, []),
- modules_of(T, [{V, Mods}|Acc]).
-
-modules_of2([], Acc) ->
- lists:reverse(Acc);
-modules_of2([Instr|Instructions], Acc) ->
- case module_of(Instr) of
- {value, Mod} ->
- modules_of2(Instructions, [Mod|Acc]);
- false ->
- modules_of2(Instructions, Acc)
- end.
-
-module_of({add_module, Module}) ->
- {value, Module};
-module_of({remove, {Module, _Pre, _Post}}) ->
- {value, Module};
-module_of({load_module, Module, _Pre, _Post, _Depend}) ->
- {value, Module};
-module_of({update, Module, _Change, _Pre, _Post, _Depend}) ->
- {value, Module};
-module_of(_) ->
- false.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% The version is a string consting of numbers separated by dots: "."
-%% Example: "3.3.3"
-%%
-check_version(V) when is_list(V) ->
- case do_check_version(string:tokens(V, [$.])) of
- ok ->
- ok;
- {error, BadVersionPart} ->
- throw({error, {bad_version, V, BadVersionPart}})
- end;
-check_version(V) ->
- error({bad_version, V}).
-
-do_check_version([]) ->
- ok;
-do_check_version([H|T]) ->
- case (catch list_to_integer(H)) of
- I when is_integer(I) ->
- do_check_version(T);
- _ ->
- {error, H}
- end.
-
-check_module(M, Modules) when is_atom(M) ->
- case lists:member(M,Modules) of
- true ->
- ok;
- false ->
- error({unknown_module, M, Modules})
- end;
-check_module(M, _) ->
- error({bad_module, M}).
-
-
-check_module_depend(M, [], _) when is_atom(M) ->
- d("check_module_depend -> entry with"
- "~n M: ~p", [M]),
- ok;
-check_module_depend(M, Deps, Modules) when is_atom(M) andalso is_list(Deps) ->
- d("check_module_depend -> entry with"
- "~n M: ~p"
- "~n Deps: ~p"
- "~n Modules: ~p", [M, Deps, Modules]),
- case [Dep || Dep <- Deps, lists:member(Dep, Modules) == false] of
- [] ->
- ok;
- Unknown ->
- error({unknown_depend_modules, Unknown})
- end;
-check_module_depend(_M, D, _Modules) ->
- d("check_module_depend -> entry when bad depend with"
- "~n D: ~p", [D]),
- error({bad_depend, D}).
-
-
-check_no_remove_depends(_Module, []) ->
- ok;
-check_no_remove_depends(Module, [Instr|Instrs]) ->
- check_no_remove_depend(Module, Instr),
- check_no_remove_depends(Module, Instrs).
-
-check_no_remove_depend(Module, {load_module, Mod, _Pre, _Post, Depend}) ->
- case lists:member(Module, Depend) of
- true ->
- error({removed_module_in_depend, load_module, Mod, Module});
- false ->
- ok
- end;
-check_no_remove_depend(Module, {update, Mod, _Change, _Pre, _Post, Depend}) ->
- case lists:member(Module, Depend) of
- true ->
- error({removed_module_in_depend, update, Mod, Module});
- false ->
- ok
- end;
-check_no_remove_depend(_, _) ->
- ok.
-
-
-check_change(soft) ->
- ok;
-check_change({advanced, _Something}) ->
- ok;
-check_change(Change) ->
- error({bad_change, Change}).
-
-
-check_purge(soft_purge) ->
- ok;
-check_purge(brutal_purge) ->
- ok;
-check_purge(Purge) ->
- error({bad_purge, Purge}).
-
-
-check_apply(Module, Function, Args) ->
- case (catch Module:module_info()) of
- Info when is_list(Info) ->
- check_exported(Function, Args, Info);
- {'EXIT', {undef, _}} ->
- error({not_existing_module, Module})
- end.
-
-check_exported(Function, Args, Info) ->
- case lists:keysearch(exports, 1, Info) of
- {value, {exports, FuncList}} ->
- Arity = length(Args),
- Arities = [A || {F, A} <- FuncList, F == Function],
- case lists:member(Arity, Arities) of
- true ->
- ok;
- false ->
- error({not_exported_function, Function, Arity})
- end;
- _ ->
- error({bad_export, Info})
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-error(Reason) ->
- throw({error, Reason}).
-
-fail(Reason) ->
- exit({suite_failed, Reason}).
-
-key1search(Key, L) ->
- case lists:keysearch(Key, 1, L) of
- undefined ->
- fail({not_found, Key, L});
- {value, {Key, Value}} ->
- Value
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-d(F, A) ->
- d(false, F, A).
-
-d(true, F, A) ->
- io:format(F ++ "~n", A);
-d(_, _, _) ->
- ok.
-
-
diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl
new file mode 100644
index 0000000000..0c004b3edb
--- /dev/null
+++ b/lib/diameter/test/diameter_codec_SUITE.erl
@@ -0,0 +1,77 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Test encode/decode of dictionary-related modules. Each test case
+%% runs multiple tests in parallel since many of the tests are just
+%% the same code with different in-data: implementing each test as a
+%% single testcase would make for much duplication with ct's
+%% requirement of one function per testcase. (Instead of allowing a
+%% testcase to be an MFA instead of function name, say.)
+%%
+
+-module(diameter_codec_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_testcase/2,
+ end_per_testcase/2]).
+
+%% testcases
+-export([base/1,
+ gen/1,
+ lib/1]).
+
+-include("diameter_ct.hrl").
+
+-define(L, atom_to_list).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [base, gen, lib].
+
+init_per_testcase(gen, Config) ->
+ [{application, ?APP, App}] = diameter_util:consult(?APP, app),
+ {modules, Ms} = lists:keyfind(modules, 1, App),
+ [_|_] = Gs = lists:filter(fun(M) ->
+ lists:prefix("diameter_gen_", ?L(M))
+ end,
+ Ms),
+ [{dicts, Gs} | Config];
+
+init_per_testcase(_Name, Config) ->
+ Config.
+
+end_per_testcase(_, _) ->
+ ok.
+
+%% ===========================================================================
+
+base(_Config) ->
+ diameter_codec_test:base().
+
+gen([{dicts, Ms} | _]) ->
+ lists:foreach(fun diameter_codec_test:gen/1, Ms).
+
+lib(_Config) ->
+ diameter_codec_test:lib().
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
new file mode 100644
index 0000000000..aab7ab35cc
--- /dev/null
+++ b/lib/diameter/test/diameter_codec_test.erl
@@ -0,0 +1,500 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_codec_test).
+
+-compile(export_all).
+
+%%
+%% Test encode/decode of dictionary-related modules.
+%%
+
+-include_lib("diameter/include/diameter.hrl").
+
+-define(BASE, diameter_gen_base_rfc3588).
+-define(BOOL, [true, false]).
+
+%% ===========================================================================
+%% Interface.
+
+base() ->
+ [] = run([{?MODULE, [base, T]} || T <- [zero, decode]]).
+
+gen(Mod) ->
+ Fs = [{Mod, F, []} || F <- [name, id, vendor_id, vendor_name]],
+ [] = run(Fs ++ [{?MODULE, [gen, Mod, T]} || T <- [messages,
+ command_codes,
+ avp_types,
+ grouped,
+ enums,
+ import_avps,
+ import_groups,
+ import_enums]]).
+
+lib() ->
+ Vs = {_,_} = values('Address'),
+ [] = run([[fun lib/2, N, Vs] || N <- [1,2]]).
+
+%% ===========================================================================
+%% Internal functions.
+
+lib(N, {_,_} = T) ->
+ B = 1 == N rem 2,
+ [] = run([[fun lib/2, A, B] || A <- element(N,T)]);
+
+lib(IP, B) ->
+ LA = tuple_to_list(IP),
+ {SA,Fun} = ip(LA),
+ [] = run([[fun lib/4, IP, B, Fun, A] || A <- [IP, LA, SA]]).
+
+lib(IP, B, Fun, A) ->
+ try Fun(A) of
+ IP when B ->
+ ok
+ catch
+ error:_ when not B ->
+ ok
+ end.
+
+ip([_,_,_,_] = A) ->
+ [$.|S] = lists:append(["." ++ integer_to_list(N) || N <- A]),
+ {S, fun diameter_lib:ip4address/1};
+ip([_,_,_,_,_,_,_,_] = A) ->
+ [$:|S] = lists:flatten([":" ++ io_lib:format("~.16B", [N]) || N <- A]),
+ {S, fun diameter_lib:ip6address/1}.
+
+%% ------------------------------------------------------------------------
+%% base/1
+%%
+%% Test of diameter_types.
+%% ------------------------------------------------------------------------
+
+base(T) ->
+ [] = run([{?MODULE, [base, T, F]} || F <- types()]).
+
+%% Ensure that 'zero' values encode only zeros.
+base(zero = T, F) ->
+ B = diameter_types:F(encode, T),
+ B = z(B);
+
+%% Ensure that we can decode what we encode and vice-versa, and that
+%% we can't decode invalid values.
+base(decode, F) ->
+ {Eq, Vs, Ns} = b(values(F)),
+ [] = run([{?MODULE, [base_decode, F, Eq, V]} || V <- Vs]),
+ [] = run([{?MODULE, [base_invalid, F, Eq, V]} || V <- Ns]).
+
+base_decode(F, Eq, Value) ->
+ d(fun(X,V) -> diameter_types:F(X,V) end, Eq, Value).
+
+base_invalid(F, Eq, Value) ->
+ try
+ base_decode(F, Eq, Value),
+ exit(nok)
+ catch
+ error: _ ->
+ ok
+ end.
+
+b({_,_,_} = T) ->
+ T;
+b({B,Vs})
+ when is_atom(B) ->
+ {B,Vs,[]};
+b({Vs,Ns}) ->
+ {true, Vs, Ns};
+b(Vs) ->
+ {true, Vs, []}.
+
+types() ->
+ [F || {F,2} <- diameter_types:module_info(exports)].
+
+%% ------------------------------------------------------------------------
+%% gen/2
+%%
+%% Test of generated encode/decode module.
+%% ------------------------------------------------------------------------
+
+gen(M, T) ->
+ [] = run(lists:map(fun(X) -> {?MODULE, [gen, M, T, X]} end,
+ fetch(T, M:dict()))).
+
+fetch(T, Spec) ->
+ case orddict:find(T, Spec) of
+ {ok, L} ->
+ L;
+ error ->
+ []
+ end.
+
+gen(M, messages, {Name, Code, Flags, _, _}) ->
+ Rname = M:msg2rec(Name),
+ Name = M:rec2msg(Rname),
+ {Code, F, _} = M:msg_header(Name),
+ 0 = F band 2#00001111,
+ Name = case M:msg_name(Code, lists:member('REQ', Flags)) of
+ N when Name /= 'answer-message' ->
+ N;
+ '' when Name == 'answer-message', M == ?BASE ->
+ Name
+ end,
+ [] = arity(M, Name, Rname);
+
+gen(M, command_codes = T, {Code, {Req, Abbr}, Ans}) ->
+ Rname = M:msg2rec(Req),
+ Rname = M:msg2rec(Abbr),
+ gen(M, T, {Code, Req, Ans});
+
+gen(M, command_codes = T, {Code, Req, {Ans, Abbr}}) ->
+ Rname = M:msg2rec(Ans),
+ Rname = M:msg2rec(Abbr),
+ gen(M, T, {Code, Req, Ans});
+
+gen(M, command_codes, {Code, Req, Ans}) ->
+ Msgs = orddict:fetch(messages, M:dict()),
+ {_, Code, _, _, _} = lists:keyfind(Req, 1, Msgs),
+ {_, Code, _, _, _} = lists:keyfind(Ans, 1, Msgs);
+
+gen(M, avp_types, {Name, Code, Type, _Flags, _Encr}) ->
+ {Code, Flags, VendorId} = M:avp_header(Name),
+ 0 = Flags band 2#00011111,
+ V = undefined /= VendorId,
+ V = 0 /= Flags band 2#10000000,
+ {Name, Type} = M:avp_name(Code, VendorId),
+ B = M:empty_value(Name),
+ B = z(B),
+ [] = avp_decode(M, Type, Name);
+
+gen(M, grouped, {Name, _, _, _}) ->
+ Rname = M:name2rec(Name),
+ [] = arity(M, Name, Rname);
+
+gen(M, enums, {Name, ED}) ->
+ [] = run([{?MODULE, [enum, M, Name, T]} || T <- ED]);
+
+gen(M, Tag, {_Mod, L}) ->
+ T = retag(Tag),
+ [] = run([{?MODULE, [gen, M, T, I]} || I <- L]).
+
+%% avp_decode/3
+
+avp_decode(Mod, Type, Name) ->
+ {Eq, Vs, _} = b(values(Type, Name, Mod)),
+ [] = run([{?MODULE, [avp_decode, Mod, Name, Type, Eq, V]}
+ || V <- v(Vs)]).
+
+avp_decode(Mod, Name, Type, Eq, Value) ->
+ d(fun(X,V) -> avp(Mod, X, V, Name, Type) end, Eq, Value).
+
+avp(Mod, decode = X, V, Name, 'Grouped') ->
+ {Rec, _} = Mod:avp(X, V, Name),
+ Rec;
+avp(Mod, X, V, Name, _) ->
+ Mod:avp(X, V, Name).
+
+%% v/1
+
+%% List of values ...
+v(Vs)
+ when is_list(Vs) ->
+ Vs;
+
+%% .. or enumeration for grouped avps. This could be quite large
+%% (millions of values) but since the avps are also tested
+%% individually don't bother trying everything. Instead, choose a
+%% reasonable number of values at random.
+v(E) ->
+ v(2000, E(0), E).
+
+v(Max, Ord, E)
+ when Ord =< Max ->
+ diameter_enum:to_list(E);
+v(Max, Ord, E) ->
+ {M,S,U} = now(),
+ random:seed(M,S,U),
+ v(Max, Ord, E, []).
+
+v(0, _, _, Acc) ->
+ Acc;
+v(N, Ord, E, Acc) ->
+ v(N-1, Ord, E, [E(random:uniform(Ord)) | Acc]).
+
+%% arity/3
+
+arity(M, Name, Rname) ->
+ Rec = M:'#new-'(Rname),
+ [] = run([{?MODULE, [arity, M, Name, F, Rec]}
+ || F <- M:'#info-'(Rname, fields)]).
+
+arity(M, Name, AvpName, Rec) ->
+ Def = M:'#get-'(AvpName, Rec),
+ Def = case M:avp_arity(Name, AvpName) of
+ 1 ->
+ undefined;
+ A when 0 /= A ->
+ []
+ end.
+
+%% enum/3
+
+enum(M, Name, {E,_}) ->
+ B = <<E:32/integer>>,
+ B = M:avp(encode, E, Name),
+ E = M:avp(decode, B, Name).
+
+retag(import_avps) -> avp_types;
+retag(import_groups) -> grouped;
+retag(import_enums) -> enums;
+
+retag(avp_types) -> import_avps;
+retag(enums) -> import_enums.
+
+%% ===========================================================================
+
+d(F, Eq, V) ->
+ B = F(encode, V),
+ D = F(decode, B),
+ V = if Eq -> %% test for value equality ...
+ D;
+ true -> %% ... or that encode/decode is idempotent
+ D = F(decode, F(encode, D)),
+ V
+ end.
+
+z(B) ->
+ << <<0>> || <<_>> <= B >>.
+
+%% values/1
+%%
+%% Return a list of base type values. Can also be wrapped in a tuple
+%% with 'false' to indicate that encode followed by decode may not be
+%% the identity map. (Although that this composition is idempotent is
+%% tested.)
+
+values('OctetString' = T) ->
+ {["", atom_to_list(T)], [-1, 256]};
+
+values('Integer32') ->
+ Mx = (1 bsl 31) - 1,
+ Mn = -1*Mx,
+ {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]};
+
+values('Integer64') ->
+ Mx = (1 bsl 63) - 1,
+ Mn = -1*Mx,
+ {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]};
+
+values('Unsigned32') ->
+ M = (1 bsl 32) - 1,
+ {[0, random(M), M], [-1, M + 1]};
+
+values('Unsigned64') ->
+ M = (1 bsl 64) - 1,
+ {[0, random(M), M], [-1, M + 1]};
+
+values('Float32') ->
+ E = (1 bsl 8) - 2,
+ F = (1 bsl 23) - 1,
+ <<Mx:32/float>> = <<0:1/integer, E:8/integer, F:23/integer>>,
+ <<Mn:32/float>> = <<1:1/integer, E:8/integer, F:23/integer>>,
+ {[0.0, infinity, '-infinity', Mx, Mn], [0]};
+
+values('Float64') ->
+ E = (1 bsl 11) - 2,
+ F = (1 bsl 52) - 1,
+ <<Mx:64/float>> = <<0:1/integer, E:11/integer, F:52/integer>>,
+ <<Mn:64/float>> = <<1:1/integer, E:11/integer, F:52/integer>>,
+ {[0.0, infinity, '-infinity', Mx, Mn], [0]};
+
+values('Address') ->
+ {[{255,0,random(16#FF),1}, {65535,0,0,random(16#FFFF),0,0,0,1}],
+ [{256,0,0,1}, {65536,0,0,0,0,0,0,1}]};
+
+values('DiameterIdentity') ->
+ {["x", "diameter.com"], [""]};
+
+values('DiameterURI') ->
+ {false, ["aaa" ++ S ++ "://diameter.se" ++ P ++ Tr ++ Pr
+ || S <- ["", "s"],
+ P <- ["", ":1234"],
+ Tr <- ["" | [";transport=" ++ X
+ || X <- ["tcp", "sctp", "udp"]]],
+ Pr <- ["" | [";protocol=" ++ X
+ || X <- ["diameter","radius","tacacs+"]]]]};
+
+values(T)
+ when T == 'IPFilterRule';
+ T == 'QoSFilterRule' ->
+ ["deny in 0 from 127.0.0.1 to 10.0.0.1"];
+
+%% RFC 3629 defines the UTF-8 encoding of U+0000 through U+10FFFF with the
+%% exception of U+D800 through U+DFFF.
+values('UTF8String') ->
+ {[[],
+ lists:seq(0,16#1FF),
+ [0,16#D7FF,16#E000,16#10FFFF],
+ [random(16#D7FF), random(16#E000,16#10FFFF)]],
+ [[-1],
+ [16#D800],
+ [16#DFFF],
+ [16#110000]]};
+
+values('Time') ->
+ {[{{1968,1,20},{3,14,8}}, %% 19000101T000000 + 1 bsl 31
+ {date(), time()},
+ {{2036,2,7},{6,28,15}},
+ {{2036,2,7},{6,28,16}}, %% 19000101T000000 + 2 bsl 31
+ {{2104,2,26},{9,42,23}}],
+ [{{1968,1,20},{3,14,7}},
+ {{2104,2,26},{9,42,24}}]}. %% 19000101T000000 + 3 bsl 31
+
+%% values/3
+%%
+%% Return list or enumerations of values for a given AVP. Can be
+%% wrapped as for values/1.
+
+values('Enumerated', Name, Mod) ->
+ {_Name, Vals} = lists:keyfind(Name, 1, types(enums, Mod)),
+ lists:map(fun({N,_}) -> N end, Vals);
+
+values('Grouped', Name, Mod) ->
+ Rname = Mod:name2rec(Name),
+ Rec = Mod:'#new-'(Rname),
+ Avps = Mod:'#info-'(Rname, fields),
+ Enum = diameter_enum:combine(lists:map(fun({_,Vs,_}) -> to_enum(Vs) end,
+ [values(F, Mod) || F <- Avps])),
+ {false, diameter_enum:append(group(Mod, Name, Rec, Avps, Enum))};
+
+values(_, 'Framed-IP-Address', _) ->
+ [{127,0,0,1}];
+
+values(Type, _, _) ->
+ values(Type).
+
+to_enum(Vs)
+ when is_list(Vs) ->
+ diameter_enum:new(Vs);
+to_enum(E) ->
+ E.
+
+%% values/2
+
+values('AVP', _) ->
+ {true, [#diameter_avp{code = 0, data = <<0>>}], []};
+
+values(Name, Mod) ->
+ Avps = types(avp_types, Mod),
+ {Name, _Code, Type, _Flags, _Encr} = lists:keyfind(Name, 1, Avps),
+ b(values(Type, Name, Mod)).
+
+%% group/5
+%%
+%% Pack four variants of group values: tagged list containing all
+%% values, the corresponding record, a minimal tagged list and the
+%% coresponding record.
+
+group(Mod, Name, Rec, Avps, Enum) ->
+ lists:map(fun(B) -> group(Mod, Name, Rec, Avps, Enum, B) end,
+ [{A,R} || A <- ?BOOL, R <- ?BOOL]).
+
+group(Mod, Name, Rec, Avps, Enum, B) ->
+ diameter_enum:map(fun(Vs) -> g(Mod, Name, Rec, Avps, Vs, B) end, Enum).
+
+g(Mod, Name, Rec, Avps, Values, {All, AsRec}) ->
+ {Tagged, []}
+ = lists:foldl(fun(N, {A, [V|Vs]}) ->
+ {pack(All, Mod:avp_arity(Name, N), N, V, A), Vs}
+ end,
+ {[], Values},
+ Avps),
+ g(AsRec, Mod, Tagged, Rec).
+
+g(true, Mod, Vals, Rec) ->
+ Mod:'#set-'(Vals, Rec);
+g(false, _, Vals, _) ->
+ Vals.
+
+pack(true, Arity, Avp, Value, Acc) ->
+ [all(Arity, Avp, Value) | Acc];
+pack(false, Arity, Avp, Value, Acc) ->
+ min(Arity, Avp, Value, Acc).
+
+all(Mod, Name, Avp, V) ->
+ all(Mod:avp_arity(Name, Avp), Avp, V).
+
+all(1, Avp, V) ->
+ {Avp, V};
+all({0,'*'}, Avp, V) ->
+ a(1, Avp, V);
+all({N,'*'}, Avp, V) ->
+ a(N, Avp, V);
+all({_,N}, Avp, V) ->
+ a(N, Avp, V).
+
+a(N, Avp, V)
+ when N /= 0 ->
+ {Avp, lists:duplicate(N,V)}.
+
+min(Mod, Name, Avp, V, Acc) ->
+ min(Mod:avp_arity(Name, Avp), Avp, V, Acc).
+
+min(1, Avp, V, Acc) ->
+ [{Avp, V} | Acc];
+min({0,_}, _, _, Acc) ->
+ Acc;
+min({N,_}, Avp, V, Acc) ->
+ [{Avp, lists:duplicate(N,V)} | Acc].
+
+%% types/2
+
+types(T, Mod) ->
+ types(T, retag(T), Mod).
+
+types(T, IT, Mod) ->
+ Dict = Mod:dict(),
+ fetch(T, Dict) ++ lists:flatmap(fun({_,As}) -> As end, fetch(IT, Dict)).
+
+%% random/[12]
+
+random(M) ->
+ random(0,M).
+
+random(Mn,Mx) ->
+ seed(get({?MODULE, seed})),
+ Mn + random:uniform(Mx - Mn + 1) - 1.
+
+seed(undefined) ->
+ put({?MODULE, seed}, true),
+ random:seed(now());
+
+seed(true) ->
+ ok.
+
+%% run/1
+%%
+%% Unravel nested badmatches resulting from [] matches on calls to
+%% run/1 to make for more readable failures.
+
+run(L) ->
+ lists:flatmap(fun flatten/1, diameter_util:run(L)).
+
+flatten({_, {{badmatch, [{_, {{badmatch, _}, _}} | _] = L}, _}}) ->
+ L;
+flatten(T) ->
+ [T].
diff --git a/lib/diameter/test/diameter_compiler_test.erl b/lib/diameter/test/diameter_compiler_test.erl
deleted file mode 100644
index ae4c9c668d..0000000000
--- a/lib/diameter/test/diameter_compiler_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the dia compiler of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_compiler_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_config_test.erl b/lib/diameter/test/diameter_config_test.erl
deleted file mode 100644
index c44fb654ab..0000000000
--- a/lib/diameter/test/diameter_config_test.erl
+++ /dev/null
@@ -1,105 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the config server of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_config_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
-
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl
new file mode 100644
index 0000000000..f8ee3dc1d7
--- /dev/null
+++ b/lib/diameter/test/diameter_ct.erl
@@ -0,0 +1,55 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_ct).
+
+%%
+%% Module used to run suites from Makefile.
+%%
+
+-export([run/1]).
+
+%% ct:run_test/1 is currently documented as returning a list of test
+%% results ... but no. Instead it returns 'ok' regardless of whether
+%% or not the suite in question has failed testcases.
+
+run([Suite]) ->
+ Start = info(),
+ ok = ct:run_test([{suite, Suite},
+ {logdir, "./log"},
+ {auto_compile, false}]),
+ info(Start , info()).
+
+info() ->
+ [{time, now()},
+ {process_count, erlang:system_info(process_count)}
+ | erlang:memory()].
+
+info(L0, L1) ->
+ [T, C | M]
+ = lists:zipwith(fun({T,N0}, {T,N1}) -> {T, N1, diff(T, N0, N1)} end,
+ L0,
+ L1),
+ Diff = [T, C, {memory, M}],
+ ct:pal("INFO: ~p~n", [Diff]).
+
+diff(time, T0, T1) ->
+ timer:now_diff(T1, T0);
+diff(_, N0, N1) ->
+ N1 - N0.
diff --git a/lib/diameter/test/diameter_ct.hrl b/lib/diameter/test/diameter_ct.hrl
new file mode 100644
index 0000000000..b6bd2ca9da
--- /dev/null
+++ b/lib/diameter/test/diameter_ct.hrl
@@ -0,0 +1,21 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-define(APP, diameter).
+-define(ERROR(T), erlang:error({?MODULE, ?LINE, T})).
diff --git a/lib/diameter/test/diameter_dict_SUITE.erl b/lib/diameter/test/diameter_dict_SUITE.erl
new file mode 100644
index 0000000000..87bb9727fe
--- /dev/null
+++ b/lib/diameter/test/diameter_dict_SUITE.erl
@@ -0,0 +1,151 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the dict-like diameter_dict.
+%%
+
+-module(diameter_dict_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2]).
+
+%% testcases
+-export([append/1,
+ fetch/1,
+ fetch_keys/1,
+ filter/1,
+ find/1,
+ fold/1,
+ is_key/1,
+ map/1,
+ merge/1,
+ update/1,
+ update_counter/1]).
+
+-include("diameter_ct.hrl").
+
+-define(dict, diameter_dict).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [append,
+ fetch,
+ fetch_keys,
+ filter,
+ find,
+ fold,
+ is_key,
+ map,
+ merge,
+ update,
+ update_counter].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+%% ===========================================================================
+
+-define(KV100, [{N,[N]} || N <- lists:seq(1,100)]).
+
+append(_) ->
+ D = ?dict:append(k, v, ?dict:new()),
+ [{k,[v,v]}] = ?dict:to_list(?dict:append(k, v, D)).
+
+fetch(_) ->
+ D = ?dict:from_list(?KV100),
+ [50] = ?dict:fetch(50, D),
+ Ref = make_ref(),
+ Ref = try ?dict:fetch(Ref, D) catch _:_ -> Ref end.
+
+fetch_keys(_) ->
+ L = ?KV100,
+ D = ?dict:from_list(L),
+ L = [{N,[N]} || N <- lists:sort(?dict:fetch_keys(D))].
+
+filter(_) ->
+ L = ?KV100,
+ F = fun(K,[_]) -> 0 == K rem 2 end,
+ D = ?dict:filter(F, ?dict:from_list(L)),
+ true = [T || {K,V} = T <- L, F(K,V)] == lists:sort(?dict:to_list(D)).
+
+find(_) ->
+ D = ?dict:from_list(?KV100),
+ {ok, [50]} = ?dict:find(50, D),
+ error = ?dict:find(make_ref(), D).
+
+fold(_) ->
+ L = ?KV100,
+ S = lists:sum([N || {N,_} <- L]),
+ S = ?dict:fold(fun(K,[_],A) -> K + A end, 0, ?dict:from_list(L)).
+
+is_key(_) ->
+ L = ?KV100,
+ D = ?dict:from_list(L),
+ true = lists:all(fun({N,_}) -> ?dict:is_key(N,D) end, L),
+ false = ?dict:is_key(make_ref(), D).
+
+map(_) ->
+ L = ?KV100,
+ F = fun(_,V) -> [N] = V, N*2 end,
+ D = ?dict:map(F, ?dict:from_list(L)),
+ M = [{K, F(K,V)} || {K,V} <- L],
+ M = lists:sort(?dict:to_list(D)).
+
+merge(_) ->
+ L = ?KV100,
+ F = fun(_,V1,V2) -> V1 ++ V2 end,
+ D = ?dict:merge(F, ?dict:from_list(L), ?dict:from_list(L)),
+ M = [{K, F(K,V,V)} || {K,V} <- L],
+ M = lists:sort(?dict:to_list(D)).
+
+update(_) ->
+ L = ?KV100,
+ F = fun([V]) -> 2*V end,
+ D = ?dict:update(50, F, ?dict:from_list(L)),
+ 100 = ?dict:fetch(50, D),
+ Ref = make_ref(),
+ Ref = try ?dict:update(Ref, F, D) catch _:_ -> Ref end,
+ [Ref] = ?dict:fetch(Ref, ?dict:update(Ref,
+ fun(_,_) -> ?ERROR(i_think_not) end,
+ [Ref],
+ D)).
+
+update_counter(_) ->
+ L = [{N,2*N} || {N,_} <- ?KV100],
+ D = ?dict:update_counter(50, 20, ?dict:from_list(L)),
+ 120 = ?dict:fetch(50,D),
+ 2 = ?dict:fetch(1,D).
diff --git a/lib/diameter/test/diameter_enum.erl b/lib/diameter/test/diameter_enum.erl
new file mode 100644
index 0000000000..dfb6d04e3c
--- /dev/null
+++ b/lib/diameter/test/diameter_enum.erl
@@ -0,0 +1,406 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_enum).
+
+%%
+%% This module constructs finite enumerations.
+%%
+%% An enumeration is represented as a function on integers, 0 mapping
+%% to the number of values enumerated and successive integers mapping
+%% to enumerated values. The function will fail on anything but 0 and
+%% positive integers less then or equal to the value of the function
+%% at 0.
+%%
+%% The purpose of this is to provide a way of stepping through a large
+%% number of values without explicitly constructing the list of all
+%% possible values. For example, consider the following function that
+%% given a list of lists constructs the list of all possible lists
+%% constructed by choosing one element from each sublist.
+%%
+%% combine([H]) ->
+%% [[X] || X <- H];
+%% combine([H|T]) ->
+%% Ys = combine(T),
+%% [[X|Y] || X <- H, Y <- Ys].
+%%
+%% Eg. [[1,2],[3,4,5]] -> [[1,3],[1,4],[1,5],[2,3],[2,4],[2,5]]
+%%
+%% If L is a list of three 1000 element lists then combine(L) would
+%% construct a list of length 10^9 which will likely exhaust available
+%% memory. (Which is how this module came into being. A tail-recursive
+%% implementation doesn't fare much better.) By contrast,
+%%
+%% F = enum:combine([enum:new(L) || L <- Lists])
+%%
+%% only maps existing lists. It may still be undesirable to step
+%% through a very large number of values but it's possible, and easy
+%% to step through a selection of values as an alternative.
+%%
+
+%% Functions that return enumerations.
+-export([new/1,
+ combine/1,
+ reverse/1,
+ map/2,
+ append/1,
+ duplicate/2,
+ nthtail/2,
+ seq/2,
+ seq/3,
+ zip/1,
+ zip/2,
+ slice/3,
+ split/2]).
+
+%% Functions that operate on existing enumerations.
+-export([foreach/2,
+ foldl/3,
+ foldr/3,
+ all/2,
+ any/2,
+ member/2,
+ last/1,
+ nth/2,
+ to_list/1]).
+
+%% ------------------------------------------------------------------------
+%% new/1
+%%
+%% Turn a list/tuple of values into an enumeration that steps through
+%% each element. Turn anything else into an enumeration of that single
+%% value.
+%% ------------------------------------------------------------------------
+
+new(L)
+ when is_list(L) ->
+ new(list_to_tuple(L));
+
+new(T)
+ when is_tuple(T) ->
+ enum(size(T), fun(N) -> element(N,T) end);
+
+new(T) ->
+ fun(0) -> 1; (1) -> T end.
+
+enum(Ord, F) ->
+ fun(0) -> Ord; (N) when 0 < N, N =< Ord -> F(N) end.
+
+%% ------------------------------------------------------------------------
+%% combine/1
+%%
+%% Map a list/tuple of enumerations to the enumeration of all
+%% lists/tuples constructed by choosing one value from each
+%% enumeration in the list/tuple.
+%% ------------------------------------------------------------------------
+
+combine(T)
+ when is_tuple(T) ->
+ F = combine(tuple_to_list(T)),
+ enum(F(0), fun(N) -> list_to_tuple(F(N)) end);
+
+combine([]) ->
+ fun(0) -> 0 end;
+
+%% Given positive integers n_1,...,n_k, construct a bijection from
+%% {0,...,\prod_{i=1}^k} n_i - 1} to {0,...,n_1} x ... x {0,...,n_k}
+%% that maps N to (N_1,...,N_k) where:
+%%
+%% N_1 = (N div 1) rem n_1
+%% ...
+%% N_k = (N div n_1*...*n_{k-1}) rem n_k
+%%
+%% That is:
+%%
+%% N_i = (N div \prod_{j=1}^{i-1} n_j) rem n_i
+%%
+%% This corresponds to looping through N_1, incrementing N_2 as N_1
+%% loops, and so on up through N_k. The inverse map is as follows.
+%%
+%% (N_1,...,N_k) -> N = N_1 + N_2*n_1 + ... + N_k*n_{k-1}*...*n_1
+%%
+%% = \sum_{i=1}^k N_i*\prod_{j=i}^{i-1} n_j
+%%
+%% [Proof: Induction on k. For k=1 we have the identity map. If
+%% g_k : (N_1,...,N_k) |-> N above is bijective then consider
+%% the bijection
+%%
+%% G : (t,n) |--> t + n*K, K = n_k*...*n_1
+%%
+%% from {0,...,K-1} x {0,...,n_{k+1}-1} onto {0,...,n_{k+1}*K - 1}
+%% with inverse F : n |--> (n rem K, n div K). Since
+%%
+%% g_{k+1}(N_1,...,N_{k+1}) = g_k(N_1,...,N_K) + N_{k+1}*K
+%% = G(g_k(N_1,...,N_K), N_{k+1})
+%%
+%% and G, g_k and ((N-1,...,N_k),N_{k+1}) -> (N_1,...,N_{k+1})
+%% are all bijections, so is g_{k+1}.]
+
+combine([_|_] = L) ->
+ [Ord | Divs] = lists:foldl(fun(F,[D|_] = A) -> [F(0)*D | A] end, [1], L),
+ RL = lists:reverse(L),
+ enum(Ord, fun(N) -> combine(N, Ord, Divs, RL) end).
+
+%% Since we use 0 to return the number of elements enumerated, use
+%% bijections from {1,...,N} rather than {0,...,N-1}.
+
+combine(N, Ord, Divs, L)
+ when 0 < N, N =< Ord ->
+ {Vs, []} = lists:foldl(fun(F, {A, [D|Ds]}) ->
+ {[F(1 + (((N-1) div D) rem F(0))) | A], Ds}
+ end,
+ {[], Divs},
+ L),
+ Vs.
+
+%% ------------------------------------------------------------------------
+%% reverse/1
+%%
+%% Construct the enumeration that reverses the order in which values
+%% are traversed.
+%% ------------------------------------------------------------------------
+
+reverse(E) ->
+ Ord = E(0),
+ enum(Ord, fun(N) -> E(Ord + 1 - N) end).
+
+%% ------------------------------------------------------------------------
+%% map/2
+%%
+%% Construct an enumeration that maps enumerated values.
+%% ------------------------------------------------------------------------
+
+map(Fun, E) ->
+ enum(E(0), fun(N) -> Fun(E(N)) end).
+
+%% ------------------------------------------------------------------------
+%% append/2
+%%
+%% Construct an enumeration that successively steps through each of a
+%% list of enumerations.
+%% ------------------------------------------------------------------------
+
+append(Es) ->
+ [Ord | Os] = lists:foldl(fun(E, [N|_] = A) -> [N+E(0)|A] end, [0], Es),
+ Rev = lists:reverse(Es),
+ enum(Ord, fun(N) -> append(N, Os, Rev) end).
+
+append(N, [Ord | _], [E | _])
+ when N > Ord ->
+ E(N - Ord);
+append(N, [_|Os], [_|Es]) ->
+ append(N, Os, Es).
+
+%% ------------------------------------------------------------------------
+%% duplicate/2
+%%
+%% Construct an enumeration that traverses an enumeration multiple
+%% times. Equivalent to append(lists:duplicate(N, E)).
+%% ------------------------------------------------------------------------
+
+duplicate(N, E) ->
+ Ord = E(0),
+ enum(N*Ord, fun(M) -> E(1 + ((M-1) rem Ord)) end).
+
+%% ------------------------------------------------------------------------
+%% nthtail/2
+%%
+%% Construct an enumeration that omits values at the head of an
+%% existing enumeration.
+%% ------------------------------------------------------------------------
+
+nthtail(N, E)
+ when 0 =< N ->
+ nthtail(E(0) - N, N, E).
+
+nthtail(Ord, N, E)
+ when 0 =< Ord ->
+ enum(Ord, fun(M) -> E(M+N) end).
+
+%% ------------------------------------------------------------------------
+%% seq/[23]
+%%
+%% Construct an enumeration that steps through a sequence of integers.
+%% ------------------------------------------------------------------------
+
+seq(From, To) ->
+ seq(From, To, 1).
+
+seq(From, To, Incr)
+ when From =< To ->
+ enum((To - From + Incr) div Incr, fun(N) -> From + (N-1)*Incr end).
+
+%% ------------------------------------------------------------------------
+%% zip/[12]
+%%
+%% Construct an enumeration whose nth value is the list of nth values
+%% of a list of enumerations.
+%% ------------------------------------------------------------------------
+
+zip(Es) ->
+ zip(fun(T) -> T end, Es).
+
+zip(_, []) ->
+ [];
+zip(Fun, Es) ->
+ enum(lists:min([E(0) || E <- Es]), fun(N) -> Fun([E(N) || E <- Es]) end).
+
+%% ------------------------------------------------------------------------
+%% slice/3
+%%
+%% Construct an enumeration of a given length from a given starting point.
+%% ------------------------------------------------------------------------
+
+slice(N, Len, E)
+ when is_integer(N), N > 0, is_integer(Len), Len >= 0 ->
+ slice(N, Len, E(0) - (N - 1), E).
+
+slice(_, _, Tail, _)
+ when Tail < 1 ->
+ fun(0) -> 0 end;
+
+slice(N, Len, Tail, E) ->
+ enum(lists:min([Len, Tail]), fun(M) -> E(N-1+M) end).
+
+%% ------------------------------------------------------------------------
+%% split/2
+%%
+%% Split an enumeration into a list of enumerations of the specified
+%% length. The last enumeration of the list may have order less than
+%% this length.
+%% ------------------------------------------------------------------------
+
+split(Len, E)
+ when is_integer(Len), Len > 0 ->
+ split(1, E(0), Len, E, []).
+
+split(N, Ord, _, _, Acc)
+ when N > Ord ->
+ lists:reverse(Acc);
+
+split(N, Ord, Len, E, Acc) ->
+ split(N+Len, Ord, Len, E, [slice(N, Len, E) | Acc]).
+
+%% ------------------------------------------------------------------------
+%% foreach/2
+%%
+%% Apply a fun to each value of an enumeration.
+%% ------------------------------------------------------------------------
+
+foreach(Fun, E) ->
+ foldl(fun(N,ok) -> Fun(N), ok end, ok, E).
+
+%% ------------------------------------------------------------------------
+%% foldl/3
+%% foldr/3
+%%
+%% Fold through values in an enumeration.
+%% ------------------------------------------------------------------------
+
+foldl(Fun, Acc, E) ->
+ foldl(E(0), 1, Fun, Acc, E).
+
+foldl(M, N, _, Acc, _)
+ when N == M+1 ->
+ Acc;
+foldl(M, N, Fun, Acc, E) ->
+ foldl(M, N+1, Fun, Fun(E(N), Acc), E).
+
+foldr(Fun, Acc, E) ->
+ foldl(Fun, Acc, reverse(E)).
+
+%% ------------------------------------------------------------------------
+%% all/2
+%%
+%% Do all values of an enumeration satisfy a predicate?
+%% ------------------------------------------------------------------------
+
+all(Pred, E) ->
+ all(E(0), 1, Pred, E).
+
+all(M, N, _, _)
+ when N == M+1 ->
+ true;
+all(M, N, Pred, E) ->
+ Pred(E(N)) andalso all(M, N+1, Pred, E).
+
+%% Note that andalso/orelse are tail-recusive as of R13A.
+
+%% ------------------------------------------------------------------------
+%% any/2
+%%
+%% Does any value of an enumeration satisfy a predicate?
+%% ------------------------------------------------------------------------
+
+any(Pred, E) ->
+ any(E(0), 1, Pred, E).
+
+any(M, N, _, _)
+ when N == M+1 ->
+ false;
+any(M, N, Pred, E) ->
+ Pred(E(N)) orelse any(M, N+1, Pred, E).
+
+%% ------------------------------------------------------------------------
+%% member/2
+%%
+%% Does a value match any in an enumeration?
+%% ------------------------------------------------------------------------
+
+member(X, E) ->
+ member(E(0), 1, X, E).
+
+member(M, N, _, _)
+ when N == M+1 ->
+ false;
+member(M, N, X, E) ->
+ match(E(N), X) orelse member(M, N+1, X, E).
+
+match(X, X) ->
+ true;
+match(_, _) ->
+ false.
+
+%% ------------------------------------------------------------------------
+%% last/1
+%%
+%% Return the last value of an enumeration.
+%% ------------------------------------------------------------------------
+
+last(E) ->
+ E(E(0)).
+
+%% ------------------------------------------------------------------------
+%% nth/2
+%%
+%% Return a selected value of an enumeration.
+%% ------------------------------------------------------------------------
+
+nth(N, E) ->
+ E(N).
+
+%% ------------------------------------------------------------------------
+%% to_list/1
+%%
+%% Turn an enumeration into a list. Not good if the very many values
+%% are enumerated.
+%% ------------------------------------------------------------------------
+
+to_list(E) ->
+ foldr(fun(X,A) -> [X|A] end, [], E).
diff --git a/lib/diameter/test/diameter_etcp_test.beam b/lib/diameter/test/diameter_etcp_test.beam
deleted file mode 100644
index efaaec69d5..0000000000
--- a/lib/diameter/test/diameter_etcp_test.beam
+++ /dev/null
Binary files differ
diff --git a/lib/diameter/test/diameter_peer_test.erl b/lib/diameter/test/diameter_peer_test.erl
deleted file mode 100644
index 27e75e26ef..0000000000
--- a/lib/diameter/test/diameter_peer_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the peer component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_peer_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_reg_SUITE.erl b/lib/diameter/test/diameter_reg_SUITE.erl
new file mode 100644
index 0000000000..ade824c9dd
--- /dev/null
+++ b/lib/diameter/test/diameter_reg_SUITE.erl
@@ -0,0 +1,119 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the server implemented by diameter_reg.erl.
+%%
+
+-module(diameter_reg_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([add/1,
+ add_new/1,
+ del/1,
+ repl/1,
+ terms/1,
+ pids/1]).
+
+-define(reg, diameter_reg).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [add,
+ add_new,
+ del,
+ repl,
+ terms,
+ pids].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+add(_) ->
+ Ref = make_ref(),
+ true = ?reg:add(Ref),
+ true = ?reg:add(Ref),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+add_new(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ false = ?reg:add_new(Ref).
+
+del(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ true = ?reg:add_new({Ref}),
+ true = ?reg:del({Ref}),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+repl(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new({Ref}),
+ true = ?reg:repl({Ref}, Ref),
+ false = ?reg:add_new(Ref),
+ false = ?reg:repl({Ref}, Ref),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+terms(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ [[Pid]] = [L || {T,L} <- ?reg:terms(), T == Ref],
+ Pid = self().
+
+pids(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ %% Don't match [[Ref]] since this will only necessarily be the
+ %% case when the test is run in its own process.
+ [_|_] = [L || {P,L} <- ?reg:pids(), P == self()].
diff --git a/lib/diameter/test/diameter_reg_test.erl b/lib/diameter/test/diameter_reg_test.erl
deleted file mode 100644
index a2638d6712..0000000000
--- a/lib/diameter/test/diameter_reg_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011_2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the reg component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_reg_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
new file mode 100644
index 0000000000..0cda2df8ca
--- /dev/null
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -0,0 +1,422 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of traffic between seven Diameter nodes connected as follows.
+%%
+%% --- SERVER1.REALM2
+%% /
+%% ---- RELAY.REALM2 ---- SERVER2.REALM2
+%% / |
+%% CLIENT.REALM1 |
+%% \ |
+%% ---- RELAY.REALM3 ---- SERVER2.REALM3
+%% \
+%% --- SERVER2.REALM3
+%%
+
+-module(diameter_relay_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([send1/1,
+ send2/1,
+ send3/1,
+ send4/1,
+ send_loop/1,
+ send_timeout_1/1,
+ send_timeout_2/1,
+ remove_transports/1,
+ stop_services/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT.REALM1").
+-define(RELAY1, "RELAY.REALM2").
+-define(SERVER1, "SERVER1.REALM2").
+-define(SERVER2, "SERVER2.REALM2").
+-define(RELAY2, "RELAY.REALM3").
+-define(SERVER3, "SERVER1.REALM3").
+-define(SERVER4, "SERVER2.REALM3").
+
+-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
+-define(DICT_RELAY, ?DIAMETER_DICT_RELAY).
+
+-define(APP_ALIAS, the_app).
+-define(APP_ID, ?DICT_COMMON:id()).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host, Dict),
+ [{'Origin-Host', Host},
+ {'Origin-Realm', realm(Host)},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Acct-Application-Id', [Dict:id()]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, Dict},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+%% Config for diameter:add_transport/2. In the listening case, listen
+%% on a free port that we then lookup using the implementation detail
+%% that diameter_tcp registers the port with diameter_reg.
+-define(CONNECT(PortNr),
+ {connect, [{transport_module, diameter_tcp},
+ {transport_config, [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}]}]}).
+-define(LISTEN,
+ {listen, [{transport_module, diameter_tcp},
+ {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
+
+-define(SUCCESS, 2001).
+-define(LOOP_DETECTED, 3005).
+-define(UNABLE_TO_DELIVER, 3002).
+
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+-define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
+
+-define(A, list_to_atom).
+-define(L, atom_to_list).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, N} || {N, _, _} <- groups()]
+ ++ [remove_transports, stop_services].
+
+groups() ->
+ Ts = tc(),
+ [{all, [], Ts},
+ {p, [parallel], Ts}].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+
+ dbg:tracer(port, dbg:trace_port(file, "relay.dbg")),
+ dbg:p(all,c),
+ dbg:tpl(diameter_service, x),
+ dbg:tp(?MODULE, x),
+
+
+ [S1,S2,S3,S4] = S = [server(N, ?DICT_COMMON) || N <- [?SERVER1,
+ ?SERVER2,
+ ?SERVER3,
+ ?SERVER4]],
+ [R1,R2] = R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ true = diameter:subscribe(?RELAY1),
+ true = diameter:subscribe(?RELAY2),
+ true = diameter:subscribe(?CLIENT),
+
+ [C1,C2] = connect(?RELAY1, [S1,S2]),
+ [C3,C4] = connect(?RELAY2, [S3,S4]),
+ [C5,C6] = connect(?CLIENT, [R1,R2]),
+
+ C7 = connect(?RELAY1, R2),
+
+ [{transports, {S, R, [C1,C2,C3,C4,C5,C6,C7]}} | Config].
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% Testcases to run when services are started and connections
+%% established.
+tc() ->
+ [send1,
+ send2,
+ send3,
+ send4,
+ send_loop,
+ send_timeout_1,
+ send_timeout_2].
+
+server(Host, Dict) ->
+ ok = diameter:start_service(Host, ?SERVICE(Host, Dict)),
+ {ok, LRef} = diameter:add_transport(Host, ?LISTEN),
+ {LRef, portnr(LRef)}.
+
+connect(Host, {_LRef, PortNr}) ->
+ {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)),
+ ok = receive
+ #diameter_event{service = Host,
+ info = {up, Ref, _, _, #diameter_packet{}}} ->
+ ok
+ after 2000 ->
+ false
+ end,
+ Ref;
+connect(Host, Ports) ->
+ [connect(Host, P) || P <- Ports].
+
+portnr(LRef) ->
+ portnr(LRef, 20).
+
+portnr(LRef, N)
+ when 0 < N ->
+ case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
+ [{T, _Pid}] ->
+ {_, _, {LRef, {_Addr, LSock}}} = T,
+ {ok, PortNr} = inet:port(LSock),
+ PortNr;
+ [] ->
+ receive after 50 -> ok end,
+ portnr(LRef, N-1)
+ end.
+
+realm(Host) ->
+ tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
+%% ===========================================================================
+
+%% Send an STR intended for a specific server and expect success.
+send1(_Config) ->
+ call(?SERVER1).
+send2(_Config) ->
+ call(?SERVER2).
+send3(_Config) ->
+ call(?SERVER3).
+send4(_Config) ->
+ call(?SERVER4).
+
+%% Send an ASR that loops between the relays and expect the loop to
+%% be detected.
+send_loop(_Config) ->
+ Req = ['ASR', {'Destination-Realm', realm(?SERVER1)},
+ {'Destination-Host', ?SERVER1},
+ {'Auth-Application-Id', ?APP_ID}],
+ #'diameter_base_answer-message'{'Result-Code' = ?LOOP_DETECTED}
+ = call(Req, [{filter, realm}]).
+
+%% Send a RAR that is incorrectly routed and then discarded and expect
+%% different results depending on whether or not we or the relay
+%% timeout first.
+send_timeout_1(_Config) ->
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = send_timeout(7000).
+send_timeout_2(_Config) ->
+ {error, timeout} = send_timeout(3000).
+
+send_timeout(Tmo) ->
+ Req = ['RAR', {'Destination-Realm', realm(?SERVER1)},
+ {'Destination-Host', ?SERVER1},
+ {'Auth-Application-Id', ?APP_ID},
+ {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
+ call(Req, [{filter, realm}, {timeout, Tmo}]).
+
+%% Remove the client transports and expect the corresponding server
+%% transport to go down.
+remove_transports(Config) ->
+ {[S1,S2,S3,S4], [R1,R2], [C1,C2,C3,C4,C5,C6,C7]}
+ = proplists:get_value(transports, Config),
+
+ true = diameter:subscribe(?SERVER1),
+ true = diameter:subscribe(?SERVER2),
+ true = diameter:subscribe(?SERVER3),
+ true = diameter:subscribe(?SERVER4),
+ true = diameter:subscribe(?RELAY1),
+ true = diameter:subscribe(?RELAY2),
+
+ disconnect(S1, ?RELAY1, C1),
+ disconnect(S2, ?RELAY1, C2),
+ disconnect(S3, ?RELAY2, C3),
+ disconnect(S4, ?RELAY2, C4),
+ disconnect(R1, ?CLIENT, C5),
+ disconnect(R2, ?CLIENT, C6),
+ disconnect(R2, ?RELAY1, C7).
+
+disconnect({LRef, _PortNr}, Client, CRef) ->
+ ok = diameter:remove_transport(Client, CRef),
+ ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
+ after 2000 -> false
+ end.
+
+stop_services(_Config) ->
+ S = [?CLIENT, ?RELAY1, ?RELAY2, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4],
+ Ok = [ok || _ <- S],
+ Ok = [diameter:stop_service(H) || H <- S].
+
+%% ===========================================================================
+
+call(Server) ->
+ Realm = realm(Server),
+ Req = ['STR', {'Destination-Realm', Realm},
+ {'Destination-Host', [Server]},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Origin-Host' = Server,
+ 'Origin-Realm' = Realm}
+ = call(Req, [{filter, realm}]).
+
+call(Req, Opts) ->
+ diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
+
+set([H|T], Vs) ->
+ [H | Vs ++ T].
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+pick_peer([Peer | _], _, Svc, _State)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2;
+ Svc == ?CLIENT->
+ {ok, Peer}.
+
+%% prepare_request/3
+
+prepare_request(Pkt, Svc, _Peer)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2 ->
+ {send, Pkt};
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) ->
+ {send, prepare(Pkt, Caps)}.
+
+prepare(#diameter_packet{msg = Req}, Caps) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR}]).
+
+%% prepare_retransmit/3
+
+prepare_retransmit(_Pkt, false, _Peer) ->
+ discard.
+
+%% handle_answer/4
+
+%% A relay must return Pkt.
+handle_answer(Pkt, _Req, Svc, _Peer)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2 ->
+ Pkt;
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, _Svc, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+handle_request(Pkt, OH, {_Ref, #diameter_caps{origin_host = {OH,_}} = Caps})
+ when OH /= ?CLIENT ->
+ request(Pkt, Caps).
+
+%% RELAY1 routes any ASR or RAR to RELAY2 ...
+request(#diameter_packet{header = #diameter_header{cmd_code = C}},
+ #diameter_caps{origin_host = {?RELAY1, _}})
+ when C == 274; %% ASR
+ C == 258 -> %% RAR
+ {relay, [{filter, {realm, realm(?RELAY2)}}]};
+
+%% ... which in turn routes it back. Expect diameter to either answer
+%% either with DIAMETER_LOOP_DETECTED/DIAMETER_UNABLE_TO_COMPLY.
+request(#diameter_packet{header = #diameter_header{cmd_code = 274}},
+ #diameter_caps{origin_host = {?RELAY2, _}}) ->
+ {relay, [{filter, {host, ?RELAY1}}]};
+request(#diameter_packet{header = #diameter_header{cmd_code = 258}},
+ #diameter_caps{origin_host = {?RELAY2, _}}) ->
+ discard;
+
+%% Other request to a relay: send on to one of the servers in the
+%% same realm.
+request(_Pkt, #diameter_caps{origin_host = {OH, _}})
+ when OH == ?RELAY1;
+ OH == ?RELAY2 ->
+ {relay, [{filter, {all, [host, realm]}}]};
+
+%% Request received by a server: answer.
+request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
+ 'Origin-Host' = Host,
+ 'Origin-Realm' = Realm,
+ 'Route-Record' = Route}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ %% The request should have the Origin-Host/Realm of the original
+ %% sender.
+ R = realm(?CLIENT),
+ {?CLIENT, R} = {Host, Realm},
+ %% A relay appends the identity of the peer that a request was
+ %% received from to the Route-Record avp.
+ [?CLIENT] = Route,
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}}.
diff --git a/lib/diameter/test/diameter_session_test.erl b/lib/diameter/test/diameter_session_test.erl
deleted file mode 100644
index a32647d83d..0000000000
--- a/lib/diameter/test/diameter_session_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the session component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_session_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_stats_SUITE.erl b/lib/diameter/test/diameter_stats_SUITE.erl
new file mode 100644
index 0000000000..e50a0050a6
--- /dev/null
+++ b/lib/diameter/test/diameter_stats_SUITE.erl
@@ -0,0 +1,92 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the server implemented by diameter_stats.erl.
+%%
+
+-module(diameter_stats_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([an/1,
+ twa/1]).
+
+-define(stat, diameter_stats).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [an,
+ twa].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+an(_) ->
+ Ref = {'_', make_ref()},
+ true = ?stat:reg(Ref),
+ true = ?stat:reg(Ref), %% duplicate
+ ok = ?stat:incr(x),
+ ok = ?stat:incr(x, Ref),
+ ok = ?stat:incr(y, 2),
+ ok = ?stat:incr(y, Ref),
+ %% Flushing a pid flushes even stats on the registered reference.
+ [{x,2},{y,3}] = lists:sort(?stat:flush()),
+ [] = ?stat:flush(Ref),
+ [] = ?stat:flush().
+
+twa(_) ->
+ Ref = make_ref(),
+ ok = ?stat:incr(x, 8),
+ ok = ?stat:incr(x, Ref, 7),
+ %% Flushing a reference doesn't affect registered pids.
+ [{x,7}] = ?stat:flush(Ref),
+ [] = ?stat:flush(Ref),
+ [{x,8}] = ?stat:flush(),
+ [] = ?stat:flush().
diff --git a/lib/diameter/test/diameter_stats_test.erl b/lib/diameter/test/diameter_stats_test.erl
deleted file mode 100644
index 8b666edf50..0000000000
--- a/lib/diameter/test/diameter_stats_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the stats component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_stats_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_sync_SUITE.erl b/lib/diameter/test/diameter_sync_SUITE.erl
new file mode 100644
index 0000000000..84f77b6066
--- /dev/null
+++ b/lib/diameter/test/diameter_sync_SUITE.erl
@@ -0,0 +1,139 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the server implemented by diameter_sync.erl.
+%%
+
+-module(diameter_sync_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([call/1,
+ cast/1,
+ timeout/1,
+ flush/1]).
+
+-define(sync, diameter_sync).
+-define(util, diameter_util).
+
+-define(TIMEOUT, infinity).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [call,
+ cast,
+ timeout,
+ flush].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+call(_) ->
+ Ref = make_ref(),
+ Q = {q, Ref},
+ F = fun() -> Ref end,
+ Ref = ?sync:call(Q, F, infinity, ?TIMEOUT),
+ Ref = ?sync:call(Q, F, 0, infinity),
+ Ref = call(Q, F),
+ Ref = call(Q, {fun(_) -> Ref end, x}),
+ timeout = call(Q, fun() -> exit(unexpected) end),
+ {_,_,_} = call(Q, {erlang, now, []}),
+ {_,_,_} = call(Q, [fun erlang:now/0]).
+
+cast(_) ->
+ Ref = make_ref(),
+ Q = {q, Ref},
+ false = ?sync:carp(Q),
+ [] = ?sync:pids(Q),
+ %% Queue a request that blocks until we send it Ref and another
+ %% that exits with Ref.
+ ok = cast(Q, fun() -> receive Ref -> ok end end),
+ ok = cast(Q, fun() -> exit(Ref) end),
+ [_,Pid] = ?sync:pids(Q),
+ %% Ensure some expected truths ...
+ 2 = ?sync:pending(Q),
+ true = 2 =< ?sync:pending(),
+ true = lists:member(Q, ?sync:queues()),
+ %% ... and that the max number of requests is respected.
+ rejected = ?sync:call(Q, {erlang, now, []}, 1, ?TIMEOUT),
+ rejected = ?sync:cast(Q, {erlang, now, []}, 1, ?TIMEOUT),
+ %% Monitor on the identifiable request and see that exits when we
+ %% let the blocking request finish.
+ MRef = erlang:monitor(process, Pid),
+ {value, P} = ?sync:carp(Q),
+ P ! Ref,
+ Ref = receive
+ {'DOWN', MRef, process, _, Reason} ->
+ Reason
+ after ?TIMEOUT ->
+ false
+ end.
+
+timeout(_) ->
+ Q = make_ref(),
+ ok = ?sync:cast(Q, {timer, sleep, [2000]}, infinity, 2000),
+ timeout = ?sync:call(Q, fun() -> ok end, infinity, 1000).
+
+flush(_) ->
+ Q = make_ref(),
+ F = {timer, sleep, [2000]},
+ ok = cast(Q, F),
+ ok = cast(Q, F),
+ 1 = ?sync:flush(Q).
+
+%% ===========================================================================
+
+call(Q, Req) ->
+ sync(call, Q, Req).
+
+cast(Q, Req) ->
+ sync(cast, Q, Req).
+
+sync(F, Q, Req) ->
+ ?sync:F(Q, Req, infinity, infinity).
diff --git a/lib/diameter/test/diameter_sync_test.erl b/lib/diameter/test/diameter_sync_test.erl
deleted file mode 100644
index 618fa5021b..0000000000
--- a/lib/diameter/test/diameter_sync_test.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the sync component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_sync_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2
-
- %% foo/1
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case example
-%%
-
-%% foo(suite) ->
-%% [];
-%% foo(doc) ->
-%% [];
-%% foo(Config) when is_list(Config) ->
-%% ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/diameter/test/diameter_tcp_test.erl b/lib/diameter/test/diameter_tcp_test.erl
deleted file mode 100644
index b002a3d289..0000000000
--- a/lib/diameter/test/diameter_tcp_test.erl
+++ /dev/null
@@ -1,482 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the tcp transport component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_tcp_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/0,
- groups/0,
- init_per_suite/1, end_per_suite/1,
- suite_init/1, suite_fin/1,
- init_per_group/2, end_per_group/2,
-
- start_and_stop_transport_plain/1,
- start_and_listen/1,
- simple_connect/1,
- simple_send_and_recv/1
-
- ]).
-
--export([t/0, t/1]).
-
-%% diameter_peer (internal) callback API
--export([up/1, up/3, recv/2]).
-
--include("diameter_test_lib.hrl").
--include_lib("diameter/include/diameter.hrl").
-%% -include_lib("diameter/src/tcp/diameter_tcp.hrl").
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() ->
- [
- {group, start},
- {group, simple}
- ].
-
-groups() ->
- [
- {start, [], [start_and_stop_transport_plain, start_and_listen]},
- {simple, [], [simple_connect, simple_send_and_recv]}
- ].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(X) -> init_per_suite(X).
-
-init_per_suite(suite) -> [];
-init_per_suite(doc) -> [];
-init_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(X) -> end_per_suite(X).
-
-end_per_suite(suite) -> [];
-end_per_suite(doc) -> [];
-end_per_suite(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case(s)
-%%
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Plain start and stop of TCP transport
-%%
-
-start_and_stop_transport_plain(suite) ->
- [];
-start_and_stop_transport_plain(doc) ->
- [];
-start_and_stop_transport_plain(Config) when is_list(Config) ->
-
- ?SKIP(not_yet_implemented),
-
- %% This has been changed *a lot* since it was written...
-
- process_flag(trap_exit, true),
- Transport = ensure_transport_started(),
- TcpTransport = ensure_tcp_transport_started(),
- ensure_tcp_transport_stopped(TcpTransport),
- ensure_transport_stopped(Transport),
- i("done"),
- ok.
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Start TCP transport and then create a listen socket
-%%
-
-start_and_listen(suite) ->
- [];
-start_and_listen(doc) ->
- [];
-start_and_listen(Config) when is_list(Config) ->
-
- ?SKIP(not_yet_implemented),
-
- %% This has been changed *a lot* since it was written...
-
- process_flag(trap_exit, true),
- Transport = ensure_transport_started(),
- TcpTransport = ensure_tcp_transport_started(),
-
- case listen([{port, 0}]) of
- {ok, Acceptor} when is_pid(Acceptor) ->
- Ref = erlang:monitor(process, Acceptor),
- [{Acceptor, Info}] = diameter_tcp:which_listeners(),
- case lists:keysearch(socket, 1, Info) of
- {value, {_, Listen}} ->
- i("Listen socket: ~p"
- "~n Opts: ~p"
- "~n Stats: ~p"
- "~n Name: ~p",
- [Listen,
- ok(inet:getopts(Listen, [keepalive, delay_send])),
- ok(inet:getstat(Listen)),
- ok(inet:sockname(Listen))
- ]),
- ok;
- _ ->
- ?FAIL({bad_listener_info, Acceptor, Info})
- end,
- Crash = simulate_crash,
- exit(Acceptor, Crash),
- receive
- {'DOWN', Ref, process, Acceptor, Crash} ->
- ?SLEEP(1000),
- case diameter_tcp:which_listeners() of
- [{NewAcceptor, _NewInfo}] ->
- diameter_tcp_accept:stop(NewAcceptor),
- ?SLEEP(1000),
- case diameter_tcp:which_listeners() of
- [] ->
- ok;
- UnexpectedListeners ->
- ?FAIL({unexpected_listeners, empty, UnexpectedListeners})
- end;
- UnexpectedListeners ->
- ?FAIL({unexpected_listeners, non_empty, UnexpectedListeners})
- end
- after 5000 ->
- ?FAIL({failed_killing, Acceptor})
- end;
- Error ->
- ?FAIL({failed_creating_acceptor, Error})
- end,
- ensure_tcp_transport_stopped(TcpTransport),
- ensure_transport_stopped(Transport),
- i("done"),
- ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% TCP transport connecting
-%%
-
-simple_connect(suite) ->
- [];
-simple_connect(doc) ->
- [];
-simple_connect(Config) when is_list(Config) ->
-
- ?SKIP(not_yet_implemented),
-
- %% This has been changed *a lot* since it was written...
-
- process_flag(trap_exit, true),
- Transport = ensure_transport_started(),
- TcpTransport = ensure_tcp_transport_started(),
- {_Acceptor, Port} = ensure_tcp_listener(),
-
- {ok, Hostname} = inet:gethostname(),
-
- i("try connect"),
- Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}],
- Conn = case connect(Opts) of
- {ok, C} ->
- C;
- Error ->
- ?FAIL({failed_connecting, Error})
- end,
- i("connected: ~p", [Conn]),
-
- %% Up for connect
- receive
- {diameter, {up, Host, Port}} ->
- i("Received expected connect up (~p:~p)", [Host, Port]),
- ok
- after 5000 ->
- ?FAIL(connect_up_confirmation_timeout)
- end,
-
- %% Up for accept
- receive
- {diameter, {up, _ConnPid}} ->
- i("Received expected accept up"),
- ok
- after 5000 ->
- ?FAIL(acceptor_up_confirmation_timeout)
- end,
-
- i("try disconnect"),
- diameter_tcp:disconnect(Conn),
- ensure_tcp_transport_stopped(TcpTransport),
- ensure_transport_stopped(Transport),
- i("done"),
- ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Plain start and stop of TCP transport
-%%
-
-simple_send_and_recv(suite) ->
- [];
-simple_send_and_recv(doc) ->
- [];
-simple_send_and_recv(Config) when is_list(Config) ->
-
- ?SKIP(not_yet_implemented),
-
- %% This has been changed *a lot* since it was written...
-
- process_flag(trap_exit, true),
- %% --------------------------------------------------
- %% Start the TCP transport sub-system
- %%
-
- Transport = ensure_transport_started(),
- TcpTransport = ensure_tcp_transport_started(),
-
- {_Acceptor, Port} = ensure_tcp_listener(),
-
- {ok, Hostname} = inet:gethostname(),
-
- i("try connect"),
- Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}],
- Conn = case connect(Opts) of
- {ok, C1} ->
- C1;
- Error ->
- ?FAIL({failed_connecting, Error})
- end,
- i("connected: ~p", [Conn]),
-
- %% Up for connect
- receive
- {diameter, {up, Host, Port}} ->
- i("Received expected connect up (~p:~p)", [Host, Port]),
- ok
- after 5000 ->
- ?FAIL(connect_up_confirmation_timeout)
- end,
-
- %% Up for accept
- APid =
- receive
- {diameter, {up, C2}} ->
- i("Received expected accept up"),
- C2
- after 5000 ->
- ?FAIL(acceptor_up_confirmation_timeout)
- end,
-
- %% --------------------------------------------------
- %% Start some stuff needed for the codec to run
- %%
-
- i("start persistent table"),
- {ok, _Pers} = diameter_persistent_table:start_link(),
-
- i("start session"),
- {ok, _Session} = diameter_session:start_link(),
-
- i("try decode a (DWR) message"),
- Base = diameter_gen_base_rfc3588,
- DWR = ['DWR',
- {'Origin-Host', Hostname},
- {'Origin-Realm', "whatever-realm"},
- {'Origin-State-Id', [10]}],
-
- #diameter_packet{msg = Msg} = diameter_codec:encode(Base, DWR),
-
-
- %% --------------------------------------------------
- %% Now try to send the message
- %%
- %% This is not the codec-test suite, so we dont really care what we
- %% send, as long as it encoded/decodes correctly in the transport
- %%
-
- i("try send from connect side"),
- ok = diameter_tcp:send_message(Conn, Msg),
-
- %% Wait for data on Accept side
- APkt =
- receive
- {diameter, {recv, A}} ->
- i("[accept] Received expected data message: ~p", [A]),
- A
- after 5000 ->
- ?FAIL(acceptor_up_confirmation_timeout)
- end,
-
- %% Send the same message back, just to have something to send...
- i("try send (\"reply\") from accept side"),
- ok = diameter_tcp:send_message(APid, APkt),
-
- %% Wait for data on Connect side
- receive
- {diameter, {recv, B}} ->
- i("[connect] Received expected data message: ~p", [B]),
- ok
- after 5000 ->
- ?FAIL(acceptor_up_confirmation_timeout)
- end,
-
- i("we are done - now close shop"),
- diameter_session:stop(),
- diameter_persistent_table:stop(),
-
- ensure_tcp_transport_stopped(TcpTransport),
- ensure_transport_stopped(Transport),
- i("done"),
- ok.
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-ensure_transport_started() ->
-%% i("start diameter transport (top) supervisor"),
- case diameter_transport_sup:start_link() of
- {ok, TransportSup} ->
- TransportSup;
- Error ->
- ?FAIL({failed_starting_transport_sup, Error})
- end.
-
-ensure_transport_stopped(Pid) when is_pid(Pid) ->
-%% i("stop diameter transport (top) supervisor"),
- Stop = fun(P) -> exit(P, kill) end,
- ensure_stopped(Pid, Stop, failed_stopping_transport_sup).
-
-ensure_tcp_transport_started() ->
-%% i("start diameter TCP transport"),
- case diameter_tcp:start_transport() of
- {ok, TcpTransport} when is_pid(TcpTransport) ->
- TcpTransport;
- Error ->
- ?FAIL({failed_starting_transport, Error})
- end.
-
-ensure_tcp_transport_stopped(Pid) when is_pid(Pid) ->
-%% i("stop diameter TCP transport supervisor"),
- Stop = fun(P) -> diameter_tcp:stop_transport(P) end,
- ensure_stopped(Pid, Stop, failed_stopping_tcp_transport).
-
-
-ensure_tcp_listener() ->
-%% i("create diameter TCP transport listen socket"),
- case listen([{port, 0}]) of
- {ok, Acceptor} ->
- [{Acceptor, Info}] = diameter_tcp:which_listeners(),
- case lists:keysearch(socket, 1, Info) of
- {value, {_, Listen}} ->
- {ok, Port} = inet:port(Listen),
- {Acceptor, Port};
- _ ->
- ?FAIL({failed_retrieving_listen_socket, Info})
- end;
- Error ->
- ?FAIL({failed_creating_listen_socket, Error})
- end.
-
-
-ensure_stopped(Pid, Stop, ReasonTag) when is_pid(Pid) ->
-%% i("ensure_stopped -> create monitor to ~p", [Pid]),
- Ref = erlang:monitor(process, Pid),
-%% i("ensure_stopped -> try stop"),
- Stop(Pid),
-%% i("ensure_stopped -> await DOWN message"),
- receive
- {'DOWN', Ref, process, Pid, _} ->
-%% i("ensure_stopped -> received DOWN message"),
- ok
- after 5000 ->
-%% i("ensure_stopped -> timeout"),
- ?FAIL({ReasonTag, Pid})
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-listen(Opts) ->
- diameter_tcp:listen([{module, ?MODULE} | Opts]).
-
-connect(Opts) ->
- diameter_tcp:connect([{module, ?MODULE} | Opts]).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-up(Pid, Host, Port) ->
- Pid ! {diameter, {up, Host, Port}},
- ok.
-
-up(Pid) ->
- Pid ! {diameter, {up, self()}},
- ok.
-
-recv(Pid, Pkt) ->
- Pid ! {diameter, {recv, Pkt}}.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-i(F) ->
- i(F, []).
-
-i(F, A) ->
- io:format(F ++ "~n", A).
-
-
-ok({ok, Whatever}) ->
- Whatever;
-ok(Crap) ->
- Crap.
-
-
diff --git a/lib/diameter/test/diameter_test_lib.erl b/lib/diameter/test/diameter_test_lib.erl
deleted file mode 100644
index 3d46236526..0000000000
--- a/lib/diameter/test/diameter_test_lib.erl
+++ /dev/null
@@ -1,478 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Lightweight test server
-%%----------------------------------------------------------------------
-%%
-
--module(diameter_test_lib).
-
--export([
- sleep/1,
-
- hours/1,
- minutes/1,
- seconds/1,
-
- key1search/2,
-
- non_pc_tc_maybe_skip/4,
- os_based_skip/1,
-
- fail/3,
- skip/3,
- fatal_skip/3,
-
- log/4,
- error/3,
-
- flush/0,
-
- proxy_start/1, proxy_start/2,
- proxy_init/2,
-
- still_alive/1,
-
- prepare_test_case/5,
- lookup_config/2,
-
- mk_nodes/2, start_nodes/3,
-
- display_system_info/1, display_system_info/2, display_system_info/3,
- display_alloc_info/0,
- alloc_info/0,
-
- report_event/3
-
- ]).
-
--include("diameter_test_lib.hrl").
-
--record('REASON', {mod, line, desc}).
-
-
-%% ----------------------------------------------------------------
-%% Time related function
-%%
-
-sleep(infinity) ->
- receive
- after infinity ->
- ok
- end;
-sleep(MSecs) ->
- receive
- after trunc(MSecs) ->
- ok
- end,
- ok.
-
-
-hours(N) -> trunc(N * 1000 * 60 * 60).
-minutes(N) -> trunc(N * 1000 * 60).
-seconds(N) -> trunc(N * 1000).
-
-
-%% ----------------------------------------------------------------
-
-key1search(Key, L) ->
- case lists:keysearch(Key, 1, L) of
- undefined ->
- fail({not_found, Key, L}, ?MODULE, ?LINE);
- {value, {Key, Value}} ->
- Value
- end.
-
-
-%% ----------------------------------------------------------------
-%% Conditional skip of testcases
-%%
-
-non_pc_tc_maybe_skip(Config, Condition, File, Line)
- when is_list(Config) andalso is_function(Condition) ->
- %% Check if we shall skip the skip
- case os:getenv("TS_OS_BASED_SKIP") of
- "false" ->
- ok;
- _ ->
- case lists:keysearch(ts, 1, Config) of
- {value, {ts, megaco}} ->
- %% Always run the testcase if we are using our own
- %% test-server...
- ok;
- _ ->
- case (catch Condition()) of
- true ->
- skip(non_pc_testcase, File, Line);
- _ ->
- ok
- end
- end
- end.
-
-
-os_based_skip(any) ->
- true;
-os_based_skip(Skippable) when is_list(Skippable) ->
- {OsFam, OsName} =
- case os:type() of
- {_Fam, _Name} = FamAndName ->
- FamAndName;
- Fam ->
- {Fam, undefined}
- end,
- case lists:member(OsFam, Skippable) of
- true ->
- true;
- false ->
- case lists:keysearch(OsFam, 1, Skippable) of
- {value, {OsFam, OsName}} ->
- true;
- {value, {OsFam, OsNames}} when is_list(OsNames) ->
- lists:member(OsName, OsNames);
- _ ->
- false
- end
- end;
-os_based_skip(_) ->
- false.
-
-
-%%----------------------------------------------------------------------
-
-error(Actual, Mod, Line) ->
- global:send(megaco_global_logger, {failed, Mod, Line}),
- log("<ERROR> Bad result: ~p~n", [Actual], Mod, Line),
- Label = lists:concat([Mod, "(", Line, ") unexpected result"]),
- report_event(60, Label, [{line, Mod, Line}, {error, Actual}]),
- case global:whereis_name(megaco_test_case_sup) of
- undefined ->
- ignore;
- Pid ->
- Fail = #'REASON'{mod = Mod, line = Line, desc = Actual},
- Pid ! {fail, self(), Fail}
- end,
- Actual.
-
-log(Format, Args, Mod, Line) ->
- case global:whereis_name(megaco_global_logger) of
- undefined ->
- io:format(user, "~p~p(~p): " ++ Format,
- [self(), Mod, Line] ++ Args);
- Pid ->
- io:format(Pid, "~p~p(~p): " ++ Format,
- [self(), Mod, Line] ++ Args)
- end.
-
-skip(Actual, File, Line) ->
- log("Skipping test case~n", [], File, Line),
- String = lists:flatten(io_lib:format("Skipping test case ~p(~p): ~p~n",
- [File, Line, Actual])),
- exit({skipped, String}).
-
-fatal_skip(Actual, File, Line) ->
- error(Actual, File, Line),
- exit(shutdown).
-
-
-fail(Actual, File, Line) ->
- log("Test case failing~n", [], File, Line),
- String = lists:flatten(io_lib:format("Test case failing ~p (~p): ~p~n",
- [File, Line, Actual])),
- exit({suite_failed, String}).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Flush the message queue and return its messages
-
-flush() ->
- receive
- Msg ->
- [Msg | flush()]
- after 1000 ->
- []
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% The proxy process
-
-proxy_start(ProxyId) ->
- spawn_link(?MODULE, proxy_init, [ProxyId, self()]).
-
-proxy_start(Node, ProxyId) ->
- spawn_link(Node, ?MODULE, proxy_init, [ProxyId, self()]).
-
-proxy_init(ProxyId, Controller) ->
- process_flag(trap_exit, true),
- ?LOG("[~p] proxy started by ~p~n",[ProxyId, Controller]),
- proxy_loop(ProxyId, Controller).
-
-proxy_loop(OwnId, Controller) ->
- receive
- {'EXIT', Controller, Reason} ->
- p("proxy_loop -> received exit from controller"
- "~n Reason: ~p"
- "~n", [Reason]),
- exit(Reason);
- {apply, Fun} ->
- p("proxy_loop -> received apply request~n", []),
- Res = Fun(),
- p("proxy_loop -> apply result: "
- "~n ~p"
- "~n", [Res]),
- Controller ! {res, OwnId, Res},
- proxy_loop(OwnId, Controller);
- OtherMsg ->
- p("proxy_loop -> received unknown message: "
- "~n OtherMsg: ~p"
- "~n", [OtherMsg]),
- Controller ! {msg, OwnId, OtherMsg},
- proxy_loop(OwnId, Controller)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Check if process is alive and kicking
-still_alive(Pid) ->
- case catch erlang:is_process_alive(Pid) of % New BIF in Erlang/OTP R5
- true ->
- true;
- false ->
- false;
- {'EXIT', _} -> % Pre R5 backward compatibility
- case process_info(Pid, message_queue_len) of
- undefined -> false;
- _ -> true
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-mk_nodes(0, Nodes) ->
- Nodes;
-mk_nodes(N, []) ->
- mk_nodes(N - 1, [node()]);
-mk_nodes(N, Nodes) when N > 0 ->
- Head = hd(Nodes),
- [Name, Host] = node_to_name_and_host(Head),
- Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)].
-
-mk_node(N, Name, Host) ->
- list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])).
-
-%% Returns [Name, Host]
-node_to_name_and_host(Node) ->
- string:tokens(atom_to_list(Node), [$@]).
-
-start_nodes([Node | Nodes], File, Line) ->
- case net_adm:ping(Node) of
- pong ->
- start_nodes(Nodes, File, Line);
- pang ->
- [Name, Host] = node_to_name_and_host(Node),
- case slave:start_link(Host, Name) of
- {ok, NewNode} when NewNode =:= Node ->
- Path = code:get_path(),
- {ok, Cwd} = file:get_cwd(),
- true = rpc:call(Node, code, set_path, [Path]),
- ok = rpc:call(Node, file, set_cwd, [Cwd]),
- true = rpc:call(Node, code, set_path, [Path]),
- {_, []} = rpc:multicall(global, sync, []),
- start_nodes(Nodes, File, Line);
- Other ->
- fatal_skip({cannot_start_node, Node, Other}, File, Line)
- end
- end;
-start_nodes([], _File, _Line) ->
- ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-display_alloc_info() ->
- io:format("Allocator memory information:~n", []),
- AllocInfo = alloc_info(),
- display_alloc_info(AllocInfo).
-
-display_alloc_info([]) ->
- ok;
-display_alloc_info([{Alloc, Mem}|AllocInfo]) ->
- io:format(" ~15w: ~10w~n", [Alloc, Mem]),
- display_alloc_info(AllocInfo).
-
-alloc_info() ->
- case erlang:system_info(allocator) of
- {_Allocator, _Version, Features, _Settings} ->
- alloc_info(Features);
- _ ->
- []
- end.
-
-alloc_info(Allocators) ->
- Allocs = [temp_alloc, sl_alloc, std_alloc, ll_alloc, eheap_alloc,
- ets_alloc, binary_alloc, driver_alloc],
- alloc_info(Allocators, Allocs, []).
-
-alloc_info([], _, Acc) ->
- lists:reverse(Acc);
-alloc_info([Allocator | Allocators], Allocs, Acc) ->
- case lists:member(Allocator, Allocs) of
- true ->
- Instances0 = erlang:system_info({allocator, Allocator}),
- Instances =
- if
- is_list(Instances0) ->
- [Instance || Instance <- Instances0,
- element(1, Instance) =:= instance];
- true ->
- []
- end,
- AllocatorMem = alloc_mem_info(Instances),
- alloc_info(Allocators, Allocs, [{Allocator, AllocatorMem} | Acc]);
-
- false ->
- alloc_info(Allocators, Allocs, Acc)
- end.
-
-alloc_mem_info(Instances) ->
- alloc_mem_info(Instances, []).
-
-alloc_mem_info([], Acc) ->
- lists:sum([Mem || {instance, _, Mem} <- Acc]);
-alloc_mem_info([{instance, N, Info}|Instances], Acc) ->
- InstanceMemInfo = alloc_instance_mem_info(Info),
- alloc_mem_info(Instances, [{instance, N, InstanceMemInfo} | Acc]).
-
-alloc_instance_mem_info(InstanceInfo) ->
- MBCS = alloc_instance_mem_info(mbcs, InstanceInfo),
- SBCS = alloc_instance_mem_info(sbcs, InstanceInfo),
- MBCS + SBCS.
-
-alloc_instance_mem_info(Key, InstanceInfo) ->
- case lists:keysearch(Key, 1, InstanceInfo) of
- {value, {Key, Info}} ->
- case lists:keysearch(blocks_size, 1, Info) of
- {value, {blocks_size, Mem, _, _}} ->
- Mem;
- _ ->
- 0
- end;
- _ ->
- 0
- end.
-
-
-display_system_info(WhenStr) ->
- display_system_info(WhenStr, undefined, undefined).
-
-display_system_info(WhenStr, undefined, undefined) ->
- display_system_info(WhenStr, "");
-display_system_info(WhenStr, Mod, Func) ->
- ModFuncStr = lists:flatten(io_lib:format(" ~w:~w", [Mod, Func])),
- display_system_info(WhenStr, ModFuncStr).
-
-display_system_info(WhenStr, ModFuncStr) ->
- Fun = fun(F) -> case (catch F()) of
- {'EXIT', _} ->
- undefined;
- Res ->
- Res
- end
- end,
- ProcCount = Fun(fun() -> erlang:system_info(process_count) end),
- ProcLimit = Fun(fun() -> erlang:system_info(process_limit) end),
- ProcMemAlloc = Fun(fun() -> erlang:memory(processes) end),
- ProcMemUsed = Fun(fun() -> erlang:memory(processes_used) end),
- ProcMemBin = Fun(fun() -> erlang:memory(binary) end),
- ProcMemTot = Fun(fun() -> erlang:memory(total) end),
- %% error_logger:info_msg(
- io:format("~n"
- "~n*********************************************"
- "~n"
- "System info ~s~s => "
- "~n Process count: ~w"
- "~n Process limit: ~w"
- "~n Process memory alloc: ~w"
- "~n Process memory used: ~w"
- "~n Memory for binaries: ~w"
- "~n Memory total: ~w"
- "~n"
- "~n*********************************************"
- "~n"
- "~n", [WhenStr, ModFuncStr,
- ProcCount, ProcLimit, ProcMemAlloc, ProcMemUsed,
- ProcMemBin, ProcMemTot]),
- ok.
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-prepare_test_case(Actions, N, Config, File, Line) ->
- OrigNodes = lookup_config(nodes, Config),
- TestNodes = lookup_config(nodenames, Config), %% For testserver
- This = node(),
- SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes),
- AllNodes = [This | (SomeNodes -- [This])],
- Nodes = pick_n_nodes(N, AllNodes, File, Line),
- start_nodes(Nodes, File, Line),
- do_prepare_test_case(Actions, Nodes, Config, File, Line).
-
-do_prepare_test_case([init | Actions], Nodes, Config, File, Line) ->
- process_flag(trap_exit, true),
- megaco_test_lib:flush(),
- do_prepare_test_case(Actions, Nodes, Config, File, Line);
-do_prepare_test_case([{stop_app, App} | Actions], Nodes, Config, File, Line) ->
- _Res = rpc:multicall(Nodes, application, stop, [App]),
- do_prepare_test_case(Actions, Nodes, Config, File, Line);
-do_prepare_test_case([], Nodes, _Config, _File, _Line) ->
- Nodes.
-
-pick_n_nodes(all, AllNodes, _File, _Line) ->
- AllNodes;
-pick_n_nodes(N, AllNodes, _File, _Line)
- when is_integer(N) andalso (length(AllNodes) >= N) ->
- AllNodes -- lists:nthtail(N, AllNodes);
-pick_n_nodes(N, AllNodes, File, Line) ->
- fatal_skip({too_few_nodes, N, AllNodes}, File, Line).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-lookup_config(Key, Config) ->
- case lists:keysearch(Key, 1, Config) of
- {value, {Key, Val}} ->
- Val;
- _ ->
- []
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-report_event(_Severity, _Label, _Content) ->
- %% diameter:report_event(Severity, Label, Content).
- hopefully_traced.
-
-
-p(F,A) ->
- io:format("~p" ++ F ++ "~n", [self()|A]).
diff --git a/lib/diameter/test/diameter_test_lib.hrl b/lib/diameter/test/diameter_test_lib.hrl
deleted file mode 100644
index 0b86f38de7..0000000000
--- a/lib/diameter/test/diameter_test_lib.hrl
+++ /dev/null
@@ -1,106 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Define common macros for testing
-%%----------------------------------------------------------------------
-%%
-
--define(FLUSH(), diameter_test_lib:flush()).
-
--define(SLEEP(MSEC), diameter_test_lib:sleep(MSEC)).
--define(M(), diameter_test_lib:millis()).
--define(MDIFF(A,B), diameter_test_lib:millis_diff(A,B)).
-
--define(HOURS(T), diameter_test_lib:hours(T)).
--define(MINUTES(T), diameter_test_lib:minutes(T)).
--define(SECONDS(T), diameter_test_lib:seconds(T)).
-
--define(KEY1SEARCH(Key, L), diameter_test_lib:key1search(Key, L)).
-
-
--define(APPLY(Proxy, Fun),
- Proxy ! {apply, Fun}).
-
--define(LOG(Format, Args),
- diameter_test_lib:log(Format, Args, ?MODULE, ?LINE)).
-
--define(ERROR(Reason),
- diameter_test_lib:error(Reason, ?MODULE, ?LINE)).
-
--define(OS_BASED_SKIP(Skippable),
- diameter_test_lib:os_based_skip(Skippable)).
-
--define(NON_PC_TC_MAYBE_SKIP(Config, Condition),
- diameter_test_lib:non_pc_tc_maybe_skip(Config, Condition, ?MODULE, ?LINE)).
-
--define(FAIL(Reason),
- diameter_test_lib:fail(Reason, ?MODULE, ?LINE)).
-
--define(SKIP(Reason),
- diameter_test_lib:skip(Reason, ?MODULE, ?LINE)).
-
--define(VERIFYL(Expected, Expr),
- fun(A,B) when list(A), list(B) ->
- A1 = lists:sort(A),
- B1 = lists:sort(B),
- case A1 of
- B1 -> ?LOG("Ok, ~p~n", [B]);
- _ -> ?ERROR(B)
- end,
- B;
- (A,A) ->
- ?LOG("Ok, ~p~n", [A]),
- A;
- (A,B) ->
- ?ERROR(B),
- B
- end(Expected, (catch Expr))).
-
--define(VERIFY(Expected, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Expected -> ?LOG("Ok, ~p~n", [AcTuAlReS]);
- _ -> ?ERROR(AcTuAlReS)
- end,
- AcTuAlReS
- end()).
-
--define(RECEIVE(Expected),
- ?VERIFY(Expected, ?FLUSH())).
-
--define(MULTI_RECEIVE(Expected),
- ?VERIFY(lists:sort(Expected), lists:sort(?FLUSH()))).
-
--define(ACQUIRE_NODES(N, Config),
- diameter_test_lib:prepare_test_case([init, {stop_app, diameter}],
- N, Config, ?FILE, ?LINE)).
-
-
--define(REPORT_IMPORTANT(Label, Content), ?REPORT_EVENT(20, Label, Content)).
--define(REPORT_VERBOSE(Label, Content), ?REPORT_EVENT(40, Label, Content)).
--define(REPORT_DEBUG(Label, Content), ?REPORT_EVENT(60, Label, Content)).
--define(REPORT_TRACE(Label, Content), ?REPORT_EVENT(80, Label, Content)).
-
--define(REPORT_EVENT(Severity, Label, Content),
- diameter_test_lib:report_event(Severity, Label,
- [{line, ?MODULE, ?LINE} | Content])).
-
diff --git a/lib/diameter/test/diameter_test_server.erl b/lib/diameter/test/diameter_test_server.erl
deleted file mode 100644
index e2ff73fb8e..0000000000
--- a/lib/diameter/test/diameter_test_server.erl
+++ /dev/null
@@ -1,551 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Lightweight test server
-%%----------------------------------------------------------------------
-
--module(diameter_test_server).
-
--export([
- t/1, t/2,
-
- init_per_testcase/2,
- fin_per_testcase/2
- ]).
-
--include("diameter_test_lib.hrl").
-
-
--define(GLOGGER, diameter_global_logger).
-
-
-%% ----------------------------------------------------------------
-%%
-
-t([Case]) when is_atom(Case) ->
- t(Case);
-t(Case) ->
- process_flag(trap_exit, true),
- MEM = fun() -> case (catch erlang:memory()) of
- {'EXIT', _} ->
- [];
- Res ->
- Res
- end
- end,
- Alloc1 = diameter_test_lib:alloc_info(),
- Mem1 = MEM(),
- Res = lists:flatten(t(Case, default_config())),
- Alloc2 = diameter_test_lib:alloc_info(),
- Mem2 = MEM(),
- %% io:format("Res: ~p~n", [Res]),
- display_result(Res, Alloc1, Mem1, Alloc2, Mem2),
- Res.
-
-
-groups(Mod) when is_atom(Mod) ->
- try Mod:groups() of
- Groups when is_list(Groups) ->
- Groups;
- BadGroups ->
- exit({bad_groups, Mod, BadGroups})
- catch
- _:_ ->
- []
- end.
-
-init_suite(Mod, Config) ->
- io:format("~w:init_suite -> entry with"
- "~n Mod: ~p"
- "~n Config: ~p"
- "~n", [?MODULE, Mod, Config]),
- Mod:init_per_suite(Config).
-
-end_suite(Mod, Config) ->
- Mod:end_per_suite(Config).
-
-init_group(Mod, Group, Config) ->
- Mod:init_per_group(Group, Config).
-
-end_group(Mod, Group, Config) ->
- Mod:init_per_group(Group, Config).
-
-%% This is for sub-SUITEs
-t({_Mod, {NewMod, all}, _Groups}, _Config) when is_atom(NewMod) ->
- io:format("~w:t(all) -> entry with"
- "~n NewMod: ~p"
- "~n", [?MODULE, NewMod]),
- t(NewMod);
-t({Mod, {group, Name} = Group, Groups}, Config)
- when is_atom(Mod) andalso is_atom(Name) andalso is_list(Groups) ->
- io:format("~w:t(group) -> entry with"
- "~n Mod: ~p"
- "~n Name: ~p"
- "~n Groups: ~p"
- "~n Config: ~p"
- "~n", [?MODULE, Mod, Name, Groups, Config]),
- case lists:keysearch(Name, 1, Groups) of
- {value, {Name, _Props, GroupsAndCases}} ->
- try init_group(Mod, Name, Config) of
- Config2 when is_list(Config2) ->
- Res = [t({Mod, Case, Groups}, Config2) ||
- Case <- GroupsAndCases],
- (catch end_group(Mod, Name, Config2)),
- Res;
- Error ->
- io:format(" => group (~w) init failed: ~p~n",
- [Name, Error]),
- [{failed, {Mod, Group}, Error}]
- catch
- exit:{skipped, SkipReason} ->
- io:format(" => skipping group: ~p~n", [SkipReason]),
- [{skipped, {Mod, Group}, SkipReason, 0}];
- exit:{undef, _} ->
- [t({Mod, Case, Groups}, Config) ||
- Case <- GroupsAndCases];
- T:E ->
- [{failed, {Mod, Group}, {T,E}, 0}]
- end;
- false ->
- exit({unknown_group, Mod, Name, Groups})
- end;
-t({Mod, Fun, _}, Config)
- when is_atom(Mod) andalso is_atom(Fun) ->
- io:format("~w:t -> entry with"
- "~n Mod: ~p"
- "~n Fun: ~p"
- "~n Config: ~p"
- "~n", [?MODULE, Mod, Fun, Config]),
- case catch apply(Mod, Fun, [suite]) of
- [] ->
- io:format("Eval: ~p:", [{Mod, Fun}]),
- Res = eval(Mod, Fun, Config),
- {R, _, _, _} = Res,
- io:format(" ~p~n", [R]),
- Res;
-
- Cases when is_list(Cases) ->
- io:format("Expand: ~p ...~n", [{Mod, Fun}]),
- Map = fun(Case) when is_atom(Case) -> {Mod, Case};
- (Case) -> Case
- end,
- t(lists:map(Map, Cases), Config);
-
- {'EXIT', {undef, _}} ->
- io:format("Undefined: ~p~n", [{Mod, Fun}]),
- [{nyi, {Mod, Fun}, ok, 0}];
-
- Error ->
- io:format("Ignoring: ~p: ~p~n", [{Mod, Fun}, Error]),
- [{failed, {Mod, Fun}, Error, 0}]
- end;
-t(Mod, Config) when is_atom(Mod) ->
- io:format("~w:t -> entry with"
- "~n Mod: ~p"
- "~n Config: ~p"
- "~n", [?MODULE, Mod, Config]),
- %% This is assumed to be a test suite, so we start by calling
- %% the top test suite function(s) (all/0 and groups/0).
- case (catch Mod:all()) of
- Cases when is_list(Cases) ->
- %% The list may contain atoms (actual test cases) and
- %% group-tuples (a tuple naming a group of test cases).
- %% A group is defined by the (optional) groups/0 function.
- io:format("~w:t -> suite all ok"
- "~n Cases: ~p"
- "~n", [?MODULE, Cases]),
- Groups = groups(Mod),
- io:format("~w:t -> "
- "~n Groups: ~p"
- "~n", [?MODULE, Groups]),
- try init_suite(Mod, Config) of
- Config2 when is_list(Config2) ->
- io:format("~w:t -> suite init ok"
- "~n Config2: ~p"
- "~n", [?MODULE, Config2]),
- Res = [t({Mod, Case, Groups}, Config2) || Case <- Cases],
- (catch end_suite(Mod, Config2)),
- Res;
- Error ->
- io:format(" => suite init failed: ~p~n", [Error]),
- [{failed, {Mod, init_per_suite}, Error}]
- catch
- exit:{skipped, SkipReason} ->
- io:format(" => skipping suite: ~p~n", [SkipReason]),
- [{skipped, {Mod, init_per_suite}, SkipReason, 0}];
- exit:{undef, _} ->
- io:format("~w:t -> suite init failed. exit undef(1)~n", [?MODULE]),
- [t({Mod, Case, Groups}, Config) || Case <- Cases];
- exit:undef ->
- io:format("~w:t -> suite init failed. exit undef(2)~n", [?MODULE]),
- [t({Mod, Case, Groups}, Config) || Case <- Cases];
- T:E ->
- io:format("~w:t -> suite init failed. "
- "~n T: ~p"
- "~n E: ~p"
- "~n", [?MODULE, T,E]),
- [{failed, {Mod, init_per_suite}, {T,E}, 0}]
- end;
- {'EXIT', {undef, _}} ->
- io:format("Undefined: ~p~n", [{Mod, all}]),
- [{nyi, {Mod, all}, ok, 0}];
-
- Crap ->
- io:format("~w:t -> suite all failed: "
- "~n Crap: ~p"
- "~n", [?MODULE, Crap]),
- Crap
- end;
-t(Bad, _Config) ->
- io:format("~w:t -> entry with"
- "~n Bad: ~p"
- "~n", [?MODULE, Bad]),
- [{badarg, Bad, ok, 0}].
-
-eval(Mod, Fun, Config) ->
- TestCase = {?MODULE, Mod, Fun},
- Label = lists:concat(["TEST CASE: ", Fun]),
- ?REPORT_VERBOSE(Label ++ " started", [TestCase, Config]),
- global:register_name(diameter_test_case_sup, self()),
- Flag = process_flag(trap_exit, true),
- put(diameter_test_server, true),
- Config2 = Mod:init_per_testcase(Fun, Config),
- Self = self(),
- Pid = spawn_link(fun() -> do_eval(Self, Mod, Fun, Config2) end),
- R = wait_for_evaluator(Pid, Mod, Fun, Config2, []),
- Mod:fin_per_testcase(Fun, Config2),
- erase(diameter_test_server),
- global:unregister_name(diameter_test_case_sup),
- process_flag(trap_exit, Flag),
- R.
-
-wait_for_evaluator(Pid, Mod, Fun, Config, Errors) ->
- wait_for_evaluator(Pid, Mod, Fun, Config, Errors, 0).
-wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) ->
- TestCase = {?MODULE, Mod, Fun},
- Label = lists:concat(["TEST CASE: ", Fun]),
- receive
- {done, Pid, ok, Time} when Errors =:= [] ->
- ?REPORT_VERBOSE(Label ++ " ok",
- [{test_case, TestCase}, {config, Config}]),
- {ok, {Mod, Fun}, Errors, Time};
- {done, Pid, ok, Time} ->
- ?REPORT_VERBOSE(Label ++ " failed",
- [{test_case, TestCase}, {config, Config}]),
- {failed, {Mod, Fun}, Errors, Time};
- {done, Pid, {ok, _}, Time} when Errors =:= [] ->
- ?REPORT_VERBOSE(Label ++ " ok",
- [{test_case, TestCase}, {config, Config}]),
- {ok, {Mod, Fun}, Errors, Time};
- {done, Pid, {ok, _}, Time} ->
- ?REPORT_VERBOSE(Label ++ " failed",
- [{test_case, TestCase}, {config, Config}]),
- {failed, {Mod, Fun}, Errors, Time};
- {done, Pid, Fail, Time} ->
- ?REPORT_IMPORTANT(Label ++ " failed",
- [{test_case, TestCase},
- {config, Config},
- {return, Fail},
- {errors, Errors}]),
- {failed, {Mod, Fun}, Fail, Time};
- {'EXIT', Pid, {skipped, Reason}, Time} ->
- ?REPORT_IMPORTANT(Label ++ " skipped",
- [{test_case, TestCase},
- {config, Config},
- {skipped, Reason}]),
- {skipped, {Mod, Fun}, Errors, Time};
- {'EXIT', Pid, Reason, Time} ->
- ?REPORT_IMPORTANT(Label ++ " crashed",
- [{test_case, TestCase},
- {config, Config},
- {'EXIT', Reason}]),
- {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors], Time};
- {fail, Pid, Reason, Time} ->
- wait_for_evaluator(Pid, Mod, Fun, Config,
- Errors ++ [Reason], AccTime + Time)
- end.
-
-do_eval(ReplyTo, Mod, Fun, Config) ->
- diameter_test_lib:display_system_info("before", Mod, Fun),
- case timer:tc(Mod, Fun, [Config]) of
- {Time, {'EXIT', {skipped, Reason}}} ->
- display_tc_time(Time),
- diameter_test_lib:display_system_info("after (skipped)", Mod, Fun),
- ReplyTo ! {'EXIT', self(), {skipped, Reason}, Time};
- {Time, {'EXIT', Reason}} ->
- display_tc_time(Time),
- diameter_test_lib:display_system_info("after (crashed)", Mod, Fun),
- ReplyTo ! {'EXIT', self(), Reason, Time};
- {Time, Other} ->
- display_tc_time(Time),
- diameter_test_lib:display_system_info("after", Mod, Fun),
- ReplyTo ! {done, self(), Other, Time}
- end,
- unlink(ReplyTo),
- exit(shutdown).
-
-
-display_tc_time(Time) ->
- io:format("~n"
- "~n*********************************************"
- "~n"
- "~nTest case completion time: ~.3f sec (~w)"
- "~n", [(Time / 1000000), Time]),
- ok.
-
-
-display_result(Res, Alloc1, Mem1, Alloc2, Mem2) ->
- io:format("~nAllocator info: ~n", []),
- display_alloc(Alloc1, Alloc2),
- io:format("~nMemory info: ~n", []),
- display_memory(Mem1, Mem2),
- display_result(Res).
-
-display_alloc([], []) ->
- io:format("-~n", []),
- ok;
-display_alloc(A1, A2) ->
- do_display_alloc(A1, A2).
-
-do_display_alloc([], _) ->
- ok;
-do_display_alloc([{Alloc, Mem1}|AllocInfo1], AllocInfo2) ->
- Mem2 =
- case lists:keysearch(Alloc, 1, AllocInfo2) of
- {value, {_, Val}} ->
- Val;
- false ->
- undefined
- end,
- io:format("~15w: ~10w -> ~w~n", [Alloc, Mem1, Mem2]),
- do_display_alloc(AllocInfo1, AllocInfo2).
-
-display_memory([], []) ->
- io:format("-~n", []),
- ok;
-display_memory(Mem1, Mem2) ->
- do_display_memory(Mem1, Mem2).
-
-
-do_display_memory([], _) ->
- ok;
-do_display_memory([{Key, Mem1}|MemInfo1], MemInfo2) ->
- Mem2 =
- case lists:keysearch(Key, 1, MemInfo2) of
- {value, {_, Val}} ->
- Val;
- false ->
- undefined
- end,
- io:format("~15w: ~10w -> ~w~n", [Key, Mem1, Mem2]),
- do_display_memory(MemInfo1, MemInfo2).
-
-display_result([]) ->
- io:format("OK~n", []);
-display_result(Res) when is_list(Res) ->
- Ok = [{MF, Time} || {ok, MF, _, Time} <- Res],
- Nyi = [MF || {nyi, MF, _, _Time} <- Res],
- Skipped = [{MF, Reason} || {skipped, MF, Reason, _Time} <- Res],
- Failed = [{MF, Reason} || {failed, MF, Reason, _Time} <- Res],
- Crashed = [{MF, Reason} || {crashed, MF, Reason, _Time} <- Res],
- display_summery(Ok, Nyi, Skipped, Failed, Crashed),
- display_ok(Ok),
- display_skipped(Skipped),
- display_failed(Failed),
- display_crashed(Crashed).
-
-display_summery(Ok, Nyi, Skipped, Failed, Crashed) ->
- io:format("~nTest case summery:~n", []),
- display_summery(Ok, "successfull"),
- display_summery(Nyi, "not yet implemented"),
- display_summery(Skipped, "skipped"),
- display_summery(Failed, "failed"),
- display_summery(Crashed, "crashed"),
- io:format("~n", []).
-
-display_summery(Res, Info) ->
- io:format(" ~w test cases ~s~n", [length(Res), Info]).
-
-display_ok([]) ->
- ok;
-display_ok(Ok) ->
- io:format("Ok test cases:~n", []),
- F = fun({{M, F}, Time}) ->
- io:format(" ~w : ~w => ~.2f sec~n", [M, F, Time / 1000000])
- end,
- lists:foreach(F, Ok),
- io:format("~n", []).
-
-display_skipped([]) ->
- ok;
-display_skipped(Skipped) ->
- io:format("Skipped test cases:~n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
- lists:foreach(F, Skipped),
- io:format("~n", []).
-
-
-display_failed([]) ->
- ok;
-display_failed(Failed) ->
- io:format("Failed test cases:~n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
- lists:foreach(F, Failed),
- io:format("~n", []).
-
-display_crashed([]) ->
- ok;
-display_crashed(Crashed) ->
- io:format("Crashed test cases:~n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
- lists:foreach(F, Crashed),
- io:format("~n", []).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Test server callbacks
-init_per_testcase(_Case, Config) ->
- Pid = group_leader(),
- Name = ?GLOGGER,
- case global:whereis_name(Name) of
- undefined ->
- global:register_name(?GLOGGER, Pid);
- Pid ->
- io:format("~w:init_per_testcase -> "
- "already registered to ~p~n", [?MODULE, Pid]),
- ok;
- OtherPid when is_pid(OtherPid) ->
- io:format("~w:init_per_testcase -> "
- "already registered to other ~p (~p)~n",
- [?MODULE, OtherPid, Pid]),
- exit({already_registered, {?GLOGGER, OtherPid, Pid}})
- end,
- set_kill_timer(Config).
-
-fin_per_testcase(_Case, Config) ->
- Name = ?GLOGGER,
- case global:whereis_name(Name) of
- undefined ->
- io:format("~w:fin_per_testcase -> already un-registered~n",
- [?MODULE]),
- ok;
- Pid when is_pid(Pid) ->
- global:unregister_name(?GLOGGER),
- ok
- end,
- reset_kill_timer(Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Set kill timer
-
-set_kill_timer(Config) ->
- case init:get_argument(diameter_test_timeout) of
- {ok, _} ->
- Config;
- _ ->
- Time =
- case lookup_config(tc_timeout, Config) of
- [] ->
- timer:minutes(5);
- ConfigTime when is_integer(ConfigTime) ->
- ConfigTime
- end,
- Dog =
- case get(diameter_test_server) of
- true ->
- Self = self(),
- spawn_link(fun() -> watchdog(Self, Time) end);
- _ ->
- test_server:timetrap(Time)
- end,
- [{kill_timer, Dog}|Config]
-
-
- end.
-
-reset_kill_timer(Config) ->
- DogKiller =
- case get(diameter_test_server) of
- true ->
- fun(P) when is_pid(P) -> P ! stop;
- (_) -> ok
- end;
- _ ->
- fun(Ref) -> test_server:timetrap_cancel(Ref) end
- end,
- case lists:keysearch(kill_timer, 1, Config) of
- {value, {kill_timer, Dog}} ->
- DogKiller(Dog),
- lists:keydelete(kill_timer, 1, Config);
- _ ->
- Config
- end.
-
-watchdog(Pid, Time) ->
- erlang:now(),
- receive
- stop ->
- ok
- after Time ->
- case (catch process_info(Pid)) of
- undefined ->
- ok;
- Info ->
- ?LOG("<ERROR> Watchdog in test case timed out "
- "for ~p after ~p min"
- "~n~p"
- "~n",
- [Pid, Time div (1000*60), Info]),
- exit(Pid, kill)
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-lookup_config(Key, Config) ->
- diameter_test_lib:lookup_config(Key, Config).
-
-default_config() ->
- [{nodes, default_nodes()}, {ts, diameter}].
-
-default_nodes() ->
- mk_nodes(2, []).
-
-mk_nodes(0, Nodes) ->
- Nodes;
-mk_nodes(N, []) ->
- mk_nodes(N - 1, [node()]);
-mk_nodes(N, Nodes) when N > 0 ->
- Head = hd(Nodes),
- [Name, Host] = node_to_name_and_host(Head),
- Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)].
-
-mk_node(N, Name, Host) ->
- list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])).
-
-%% Returns [Name, Host]
-node_to_name_and_host(Node) ->
- string:tokens(atom_to_list(Node), [$@]).
-
-
-
-
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
new file mode 100644
index 0000000000..8c85323222
--- /dev/null
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -0,0 +1,779 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of traffic between two Diameter nodes, one client, one server.
+%%
+
+-module(diameter_traffic_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_suite/1,
+ end_per_suite/1,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_testcase/2,
+ end_per_testcase/2]).
+
+%% testcases
+-export([result_codes/1,
+ send_ok/1,
+ send_arbitrary/1,
+ send_unknown/1,
+ send_unknown_mandatory/1,
+ send_noreply/1,
+ send_unsupported/1,
+ send_unsupported_app/1,
+ send_error_bit/1,
+ send_unsupported_version/1,
+ send_long/1,
+ send_nopeer/1,
+ send_noapp/1,
+ send_discard/1,
+ send_any_1/1,
+ send_any_2/1,
+ send_all_1/1,
+ send_all_2/1,
+ send_timeout/1,
+ send_error/1,
+ send_detach/1,
+ send_encode_error/1,
+ send_destination_1/1,
+ send_destination_2/1,
+ send_destination_3/1,
+ send_destination_4/1,
+ send_destination_5/1,
+ send_destination_6/1,
+ send_bad_option_1/1,
+ send_bad_option_2/1,
+ send_bad_filter_1/1,
+ send_bad_filter_2/1,
+ send_bad_filter_3/1,
+ send_bad_filter_4/1,
+ send_multiple_filters_1/1,
+ send_multiple_filters_2/1,
+ send_multiple_filters_3/1,
+ send_anything/1,
+ remove_transports/1,
+ stop_services/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/5, pick_peer/6,
+ prepare_request/4, prepare_request/5,
+ prepare_retransmit/4,
+ handle_answer/5, handle_answer/6,
+ handle_error/5,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT").
+-define(SERVER, "SERVER").
+-define(REALM, "erlang.org").
+-define(HOST(Host, Realm), Host ++ [$.|Realm]).
+
+-define(APP_ALIAS, base).
+-define(EXTRA, an_extra_argument).
+-define(ENCODINGS, [list, record]).
+
+-define(DICT, ?DIAMETER_DICT_COMMON).
+-define(APP_ID, ?DIAMETER_APP_ID_COMMON).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Name),
+ [{'Origin-Host', Name ++ "." ++ ?REALM},
+ {'Origin-Realm', ?REALM},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Acct-Application-Id', [?DIAMETER_APP_ID_COMMON]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, ?DIAMETER_DICT_COMMON},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+%% Config for diameter:add_transport/2. In the listening case, listen
+%% on a free port that we then lookup using the implementation detail
+%% that diameter_tcp registers the port with diameter_reg.
+-define(CONNECT(PortNr),
+ {connect, [{transport_module, diameter_tcp},
+ {transport_config, [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}]}]}).
+-define(LISTEN,
+ {listen, [{transport_module, diameter_tcp},
+ {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
+
+-define(SUCCESS,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
+-define(COMMAND_UNSUPPORTED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED').
+-define(TOO_BUSY,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY').
+-define(APPLICATION_UNSUPPORTED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED').
+-define(INVALID_HDR_BITS,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS').
+-define(AVP_UNSUPPORTED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED').
+-define(UNSUPPORTED_VERSION,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION').
+-define(REALM_NOT_SERVED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED').
+-define(UNABLE_TO_DELIVER,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER').
+
+-define(EVENT_RECORD,
+ ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD').
+-define(AUTHORIZE_ONLY,
+ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
+-define(AUTHORIZE_AUTHENTICATE,
+ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE').
+
+-define(LOGOUT,
+ ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+-define(BAD_ANSWER,
+ ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER').
+
+-define(A, list_to_atom).
+-define(L, atom_to_list).
+-define(P(N), ?A("p_" ++ ?L(N))).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [result_codes | [{group, N} || {N, _, _} <- groups()]]
+ ++ [remove_transports, stop_services].
+
+groups() ->
+ Ts = tc(),
+ [{E, [], Ts} || E <- ?ENCODINGS]
+ ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS].
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)),
+ {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN),
+ true = diameter:subscribe(?CLIENT),
+ {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())),
+ {up, CRef, _Peer, _Config, #diameter_packet{}}
+ = receive #diameter_event{service = ?CLIENT, info = I} -> I
+ after 2000 -> false
+ end,
+ true = diameter:unsubscribe(?CLIENT),
+ [{transports, {LRef, CRef}} | Config].
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+init_per_group(Name, Config) ->
+ E = case ?L(Name) of
+ "p_" ++ Rest ->
+ ?A(Rest);
+ _ ->
+ Name
+ end,
+ [{encode, E} | Config].
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_testcase(Name, Config) ->
+ [{testcase, Name} | Config].
+
+end_per_testcase(_, _) ->
+ ok.
+
+%% Testcases to run when services are started and connections
+%% established.
+tc() ->
+ [send_ok,
+ send_arbitrary,
+ send_unknown,
+ send_unknown_mandatory,
+ send_noreply,
+ send_unsupported,
+ send_unsupported_app,
+ send_error_bit,
+ send_unsupported_version,
+ send_long,
+ send_nopeer,
+ send_noapp,
+ send_discard,
+ send_any_1,
+ send_any_2,
+ send_all_1,
+ send_all_2,
+ send_timeout,
+ send_error,
+ send_detach,
+ send_encode_error,
+ send_destination_1,
+ send_destination_2,
+ send_destination_3,
+ send_destination_4,
+ send_destination_5,
+ send_destination_6,
+ send_bad_option_1,
+ send_bad_option_2,
+ send_bad_filter_1,
+ send_bad_filter_2,
+ send_bad_filter_3,
+ send_bad_filter_4,
+ send_multiple_filters_1,
+ send_multiple_filters_2,
+ send_multiple_filters_3,
+ send_anything].
+
+portnr() ->
+ portnr(20).
+
+portnr(N)
+ when 0 < N ->
+ case diameter_reg:match({diameter_tcp, listener, '_'}) of
+ [{T, _Pid}] ->
+ {_, _, {_LRef, {_Addr, LSock}}} = T,
+ {ok, PortNr} = inet:port(LSock),
+ PortNr;
+ [] ->
+ receive after 50 -> ok end,
+ portnr(N-1)
+ end.
+
+%% ===========================================================================
+
+%% Ensure that result codes have the expected values.
+result_codes(_Config) ->
+ {2001, 3001, 3002, 3003, 3004, 3007, 3008, 5001, 5011}
+ = {?SUCCESS,
+ ?COMMAND_UNSUPPORTED,
+ ?UNABLE_TO_DELIVER,
+ ?REALM_NOT_SERVED,
+ ?TOO_BUSY,
+ ?APPLICATION_UNSUPPORTED,
+ ?INVALID_HDR_BITS,
+ ?AVP_UNSUPPORTED,
+ ?UNSUPPORTED_VERSION}.
+
+%% Send an ACR and expect success.
+send_ok(Config) ->
+ Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
+ {'Accounting-Record-Number', 1}],
+ #diameter_base_ACA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req).
+
+%% Send an ASR with an arbitrary AVP and expect success and the same
+%% AVP in the reply.
+send_arbitrary(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}],
+ #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'AVP' = Avps}
+ = call(Config, Req),
+ [#diameter_avp{name = 'Class',
+ value = "XXX"}]
+ = Avps.
+
+%% Send an unknown AVP (to some client) and check that it comes back.
+send_unknown(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]}],
+ #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'AVP' = Avps}
+ = call(Config, Req),
+ [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]
+ = Avps.
+
+%% Ditto but set the M flag.
+send_unknown_mandatory(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]}],
+ #diameter_base_ASA{'Result-Code' = ?AVP_UNSUPPORTED,
+ 'Failed-AVP' = Failed}
+ = call(Config, Req),
+ [#'diameter_base_Failed-AVP'{'AVP' = Avps}] = Failed,
+ [#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]
+ = Avps.
+
+%% Send an STR that the server ignores.
+send_noreply(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ {error, timeout} = call(Config, Req).
+
+%% Send an unsupported command and expect 3001.
+send_unsupported(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?COMMAND_UNSUPPORTED}
+ = call(Config, Req).
+
+%% Send an unsupported command and expect 3007.
+send_unsupported_app(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?APPLICATION_UNSUPPORTED}
+ = call(Config, Req).
+
+%% Send a request with the E bit set and expect 3008.
+send_error_bit(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?INVALID_HDR_BITS}
+ = call(Config, Req).
+
+%% Send a bad version and check that we get 5011.
+send_unsupported_version(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ #diameter_base_STA{'Result-Code' = ?UNSUPPORTED_VERSION}
+ = call(Config, Req).
+
+%% Send something long that will be fragmented by TCP.
+send_long(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'User-Name', [lists:duplicate(1 bsl 20, $X)]}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req).
+
+%% Send something for which pick_peer finds no suitable peer.
+send_nopeer(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]).
+
+%% Send something on an unconfigured application.
+send_noapp(_Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = diameter:call(?CLIENT, unknown_alias, Req).
+
+%% Send something that's discarded by prepare_request.
+send_discard(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, unprepared} = call(Config, Req).
+
+%% Send with a disjunctive filter.
+send_any_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{filter, {any, []}}]).
+send_any_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = call(Config, Req, [{filter, {any, [host, realm]}}]).
+
+%% Send with a conjunctive filter.
+send_all_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM),
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [{host, any},
+ {realm, Realm}]}}]).
+send_all_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Timeout before the server manages an answer.
+send_timeout(Config) ->
+ Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
+ {error, timeout} = call(Config, Req, [{timeout, 1000}]).
+
+%% Explicitly answer with an answer-message and ensure that we
+%% received the Session-Id.
+send_error(Config) ->
+ Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
+ #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY,
+ 'Session-Id' = SId}
+ = call(Config, Req),
+ undefined /= SId.
+
+%% Send a request with the detached option and receive it as a message
+%% from handle_answer instead.
+send_detach(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ Ref = make_ref(),
+ ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
+ #diameter_packet{msg = Rec, errors = []}
+ = receive {Ref, T} -> T after 2000 -> false end,
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = Rec.
+
+%% Send a request which can't be encoded and expect {error, encode}.
+send_encode_error(Config) ->
+ {error, encode} = call(Config, ['STR']). %% No Termination-Cause
+
+%% Send with filtering and expect success.
+send_destination_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, ?REALM)]}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+send_destination_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Send with filtering on and expect failure when specifying an
+%% unknown host or realm.
+send_destination_3(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Realm', "unknown.org"}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+send_destination_4(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Send without filtering and expect an error answer when specifying
+%% an unknown host or realm.
+send_destination_5(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Realm', "unknown.org"}],
+ #'diameter_base_answer-message'{'Result-Code' = ?REALM_NOT_SERVED}
+ = call(Config, Req).
+send_destination_6(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = call(Config, Req).
+
+%% Specify an invalid option and expect failure.
+send_bad_option_1(Config) ->
+ send_bad_option(Config, x).
+send_bad_option_2(Config) ->
+ send_bad_option(Config, {extra, false}).
+
+send_bad_option(Config, Opt) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ try call(Config, Req, [Opt]) of
+ T -> erlang:error({?MODULE, ?LINE, T})
+ catch
+ error: _ -> ok
+ end.
+
+%% Specify an invalid filter and expect no matching peers.
+send_bad_filter_1(Config) ->
+ send_bad_filter(Config, {all, none}).
+send_bad_filter_2(Config) ->
+ send_bad_filter(Config, {host, x}).
+send_bad_filter_3(Config) ->
+ send_bad_filter(Config, {eval, fun() -> true end}).
+send_bad_filter_4(Config) ->
+ send_bad_filter(Config, {eval, {?MODULE, not_exported, []}}).
+
+send_bad_filter(Config, F) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{filter, F}]).
+
+%% Specify multiple filter options and expect them be conjunctive.
+send_multiple_filters_1(Config) ->
+ Fun = fun(#diameter_caps{}) -> true end,
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = send_multiple_filters(Config, [host, {eval, Fun}]).
+send_multiple_filters_2(Config) ->
+ E = {erlang, is_tuple, []},
+ {error, no_connection}
+ = send_multiple_filters(Config, [realm, {neg, {eval, E}}]).
+send_multiple_filters_3(Config) ->
+ E1 = [fun(#diameter_caps{}, ok) -> true end, ok],
+ E2 = {erlang, is_tuple, []},
+ E3 = {erlang, is_record, [diameter_caps]},
+ E4 = [{erlang, is_record, []}, diameter_caps],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
+
+send_multiple_filters(Config, Fs) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ call(Config, Req, [{filter, F} || F <- Fs]).
+
+%% Ensure that we can pass a request in any form to diameter:call/4,
+%% only the return value from the prepare_request callback being
+%% significant.
+send_anything(Config) ->
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, anything).
+
+%% Remove the client transport and expect the server transport to
+%% go down.
+remove_transports(Config) ->
+ {LRef, CRef} = proplists:get_value(transports, Config),
+ true = diameter:subscribe(?SERVER),
+ ok = diameter:remove_transport(?CLIENT, CRef),
+ {down, LRef, _, _}
+ = receive #diameter_event{service = ?SERVER, info = I} -> I
+ after 2000 -> false
+ end.
+
+stop_services(_Config) ->
+ {ok, ok} = {diameter:stop_service(?CLIENT),
+ diameter:stop_service(?SERVER)}.
+
+%% ===========================================================================
+
+call(Config, Req) ->
+ call(Config, Req, []).
+
+call(Config, Req, Opts) ->
+ Name = proplists:get_value(testcase, Config),
+ Enc = proplists:get_value(encode, Config),
+ diameter:call(?CLIENT,
+ ?APP_ALIAS,
+ msg(Req, Enc),
+ [{extra, [Name]} | Opts]).
+
+msg([_|_] = L, list) ->
+ L;
+msg([H|T], record) ->
+ ?DICT:'#new-'(?DICT:msg2rec(H), T);
+msg(T, _) ->
+ T.
+
+%% Set only values that aren't already.
+set([H|T], Vs) ->
+ [H | Vs ++ T];
+set(Rec, Vs) ->
+ lists:foldl(fun({F,_} = FV, A) -> set(?DICT:'#get-'(F, A), FV, A) end,
+ Rec,
+ Vs).
+
+set(E, FV, Rec)
+ when E == undefined;
+ E == [] ->
+ ?DICT:'#set-'(FV, Rec);
+set(_, _, Rec) ->
+ Rec.
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/5/6
+
+pick_peer([Peer], _, ?CLIENT, _State, Name)
+ when Name /= send_detach ->
+ {ok, Peer}.
+
+pick_peer([_Peer], _, ?CLIENT, _State, send_nopeer, ?EXTRA) ->
+ false;
+
+pick_peer([Peer], _, ?CLIENT, _State, send_detach, {_,_}) ->
+ {ok, Peer}.
+
+%% prepare_request/4/5
+
+prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard) ->
+ {discard, unprepared};
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) ->
+ {send, prepare(Pkt, Caps, Name)}.
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, _) ->
+ {send, prepare(Pkt, Caps)}.
+
+prepare(Pkt, Caps, send_unsupported) ->
+ Req = prepare(Pkt, Caps),
+ #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
+ = E
+ = diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}),
+ E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>};
+
+prepare(Pkt, Caps, send_unsupported_app) ->
+ Req = prepare(Pkt, Caps),
+ #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
+ = E
+ = diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}),
+ E#diameter_packet{bin = <<H/binary, 42:32/integer, T/binary>>};
+
+prepare(Pkt, Caps, send_error_bit) ->
+ #diameter_packet{header = Hdr} = Pkt,
+ Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true},
+ msg = prepare(Pkt, Caps)};
+
+prepare(Pkt, Caps, send_unsupported_version) ->
+ #diameter_packet{header = Hdr} = Pkt,
+ Pkt#diameter_packet{header = Hdr#diameter_header{version = 42},
+ msg = prepare(Pkt, Caps)};
+
+prepare(Pkt, Caps, send_anything) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ prepare(Pkt#diameter_packet{msg = Req}, Caps);
+
+prepare(Pkt, Caps, _Name) ->
+ prepare(Pkt, Caps).
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_ACR);
+ 'ACR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, DR}}
+ = Caps,
+
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Realm', DR}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_ASR);
+ 'ASR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, DH},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Host', DH},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_STR);
+ 'STR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_RAR);
+ 'RAR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, DH},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Host', DH},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]).
+
+%% prepare_retransmit/4
+
+prepare_retransmit(_Pkt, false, _Peer, _Name) ->
+ discard.
+
+%% handle_answer/5/6
+
+handle_answer(Pkt, Req, ?CLIENT, Peer, Name) ->
+ answer(Pkt, Req, Peer, Name).
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer, send_detach, {Pid, Ref}) ->
+ Pid ! {Ref, Pkt}.
+
+answer(#diameter_packet{msg = Rec, errors = []}, _Req, _Peer, _) ->
+ Rec.
+
+%% handle_error/5
+
+handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+%% Note that diameter will set Result-Code and Failed-AVPs if
+%% #diameter_packet.errors is non-null.
+
+handle_request(Pkt, ?SERVER, {_Ref, Caps}) ->
+ request(Pkt, Caps).
+
+request(#diameter_packet{msg
+ = #diameter_base_ACR{'Session-Id' = SId,
+ 'Accounting-Record-Type' = RT,
+ 'Accounting-Record-Number' = RN}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, ['ACA', {'Result-Code', ?SUCCESS},
+ {'Session-Id', SId},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Accounting-Record-Type', RT},
+ {'Accounting-Record-Number', RN}]};
+
+request(#diameter_packet{msg = #diameter_base_ASR{'Session-Id' = SId,
+ 'AVP' = Avps}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'AVP' = Avps}};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Termination-Cause' = T}},
+ _Caps)
+ when T /= ?LOGOUT ->
+ discard;
+
+request(#diameter_packet{msg = #diameter_base_STR{'Destination-Realm'= R}},
+ #diameter_caps{origin_realm = {OR, _}})
+ when R /= undefined, R /= OR ->
+ {protocol_error, ?REALM_NOT_SERVED};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Destination-Host'= [H]}},
+ #diameter_caps{origin_host = {OH, _}})
+ when H /= OH ->
+ {protocol_error, ?UNABLE_TO_DELIVER};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}};
+
+request(#diameter_packet{msg = #diameter_base_RAR{}}, _Caps) ->
+ receive after 2000 -> ok end,
+ {protocol_error, ?TOO_BUSY}.
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
new file mode 100644
index 0000000000..d545859fe8
--- /dev/null
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -0,0 +1,458 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of diameter_tcp/sctp as implementations of the diameter
+%% transport interface.
+%%
+
+-module(diameter_transport_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([tcp_accept/1,
+ tcp_connect/1,
+ sctp_accept/1,
+ sctp_connect/1]).
+
+-export([accept/1,
+ connect/1,
+ init/2]).
+
+-include_lib("kernel/include/inet_sctp.hrl").
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+-define(util, diameter_util).
+
+%% Corresponding to diameter_* transport modules.
+-define(TRANSPORTS, [tcp, sctp]).
+
+%% Receive a message.
+-define(RECV(Pat, Ret), receive Pat -> Ret end).
+-define(RECV(Pat), ?RECV(Pat, now())).
+
+%% Or not.
+-define(WAIT(Ms), receive after Ms -> now() end).
+
+%% Sockets are opened on the loopback address.
+-define(ADDR, {127,0,0,1}).
+
+%% diameter_tcp doesn't use anything but host_ip_address, and that
+%% only is a local address isn't configured as at transport start.
+-define(SVC(Addrs), #diameter_service{capabilities
+ = #diameter_caps{host_ip_address
+ = Addrs}}).
+
+%% The term diameter_tcp/sctp registers after opening a listening
+%% socket. This is an implementation detail that should probably be
+%% replaced by some documented way of getting at the port number of
+%% the listening socket, which is what we're after since we specify
+%% port 0 to get something unused.
+-define(TCP_LISTENER(Ref, Addr, LSock),
+ {diameter_tcp, listener, {Ref, {Addr, LSock}}}).
+-define(SCTP_LISTENER(Ref, Addr, LSock),
+ {diameter_sctp, listener, {Ref, {[Addr], LSock}}}).
+
+%% The term we register after open a listening port with gen_tcp.
+-define(TEST_LISTENER(Ref, PortNr),
+ {?MODULE, listen, Ref, PortNr}).
+
+%% Message over the transport interface.
+-define(TMSG(T), {diameter, T}).
+
+%% Options for gen_tcp/gen_sctp.
+-define(TCP_OPTS, [binary, {active, true}, {packet, 0}]).
+-define(SCTP_OPTS, [binary, {active, true}, {sctp_initmsg, ?SCTP_INIT}]).
+
+%% Request a specific number of streams just because we can.
+-define(SCTP_INIT, #sctp_initmsg{num_ostreams = 5,
+ max_instreams = 5}).
+
+%% Messages from gen_sctp.
+-define(SCTP(Sock, Data), {sctp, Sock, _, _, Data}).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {minutes, 2}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [tcp_accept,
+ tcp_connect,
+ sctp_accept,
+ sctp_connect].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ [{sctp, have_sctp()} | Config].
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+%% tcp_accept/1
+%% sctp_accept/1
+%%
+%% diameter transport accepting, test code connecting.
+
+tcp_accept(_) ->
+ accept(tcp).
+
+sctp_accept(Config) ->
+ if_sctp(fun accept/1, Config).
+
+%% Start multiple accepting transport processes that are connected to
+%% with an equal number of connecting processes using gen_tcp/sctp
+%% directly.
+
+-define(PEER_COUNT, 8).
+
+accept(Prot) ->
+ T = {Prot, make_ref()},
+ [] = ?util:run(?util:scramble(acc(2*?PEER_COUNT, T, []))).
+
+acc(0, _, Acc) ->
+ Acc;
+acc(N, T, Acc) ->
+ acc(N-1, T, [{?MODULE, [init,
+ element(1 + N rem 2, {accept, gen_connect}),
+ T]}
+ | Acc]).
+
+%% ===========================================================================
+%% tcp_connect/1
+%% sctp_connect/1
+%%
+%% Test code accepting, diameter transport connecting.
+
+tcp_connect(_) ->
+ connect(tcp).
+
+sctp_connect(Config) ->
+ if_sctp(fun connect/1, Config).
+
+connect(Prot) ->
+ T = {Prot, make_ref()},
+ [] = ?util:run([{?MODULE, [init, X, T]} || X <- [gen_accept, connect]]).
+
+%% ===========================================================================
+%% ===========================================================================
+
+%% have_sctp/0
+
+have_sctp() ->
+ try gen_sctp:open() of
+ {ok, Sock} ->
+ gen_sctp:close(Sock),
+ true
+ catch
+ error: badarg ->
+ false
+ end.
+
+%% if_sctp/2
+
+if_sctp(F, Config) ->
+ case proplists:get_value(sctp, Config) of
+ true ->
+ F(sctp);
+ false ->
+ {skip, no_sctp}
+ end.
+
+%% init/2
+
+init(accept, {Prot, Ref}) ->
+ %% Start an accepting transport and receive notification of a
+ %% connection.
+ TPid = start_accept(Prot, Ref),
+
+ %% Receive a message and send it back.
+ <<_:8, Len:24, _/binary>> = Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)),
+
+ Len = size(Bin),
+ TPid ! ?TMSG({send, Bin}),
+
+ %% Expect the transport process to die as a result of the peer
+ %% closing the connection.
+ MRef = erlang:monitor(process, TPid),
+ ?RECV({'DOWN', MRef, process, _, _});
+
+init(gen_connect, {Prot, Ref}) ->
+ %% Lookup the peer's listening socket.
+ {ok, PortNr} = inet:port(lsock(Prot, Ref)),
+
+ %% Connect, send a message and receive it back.
+ {ok, Sock} = gen_connect(Prot, PortNr, Ref),
+ Bin = make_msg(),
+ ok = gen_send(Prot, Sock, Bin),
+ Bin = gen_recv(Prot, Sock);
+
+init(gen_accept, {Prot, Ref}) ->
+ %% Open a listening socket and publish the port number.
+ {ok, LSock} = gen_listen(Prot),
+ {ok, PortNr} = inet:port(LSock),
+ true = diameter_reg:add_new(?TEST_LISTENER(Ref, PortNr)),
+
+ %% Accept a connection, receive a message and send it back.
+ {ok, Sock} = gen_accept(Prot, LSock),
+ Bin = gen_recv(Prot, Sock),
+ ok = gen_send(Prot, Sock, Bin);
+
+init(connect, {Prot, Ref}) ->
+ %% Lookup the peer's listening socket.
+ [{?TEST_LISTENER(_, PortNr), _}] = match(?TEST_LISTENER(Ref, '_')),
+
+ %% Start a connecting transport and receive notification of
+ %% the connection.
+ TPid = start_connect(Prot, PortNr, Ref),
+
+ %% Send a message and receive it back.
+ Bin = make_msg(),
+ TPid ! ?TMSG({send, Bin}),
+ Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)),
+
+ %% Expect the transport process to die as a result of the peer
+ %% closing the connection.
+ MRef = erlang:monitor(process, TPid),
+ ?RECV({'DOWN', MRef, process, _, _}).
+
+lsock(sctp, Ref) ->
+ [{?SCTP_LISTENER(_ , _, LSock), _}]
+ = match(?SCTP_LISTENER(Ref, ?ADDR, '_')),
+ LSock;
+lsock(tcp, Ref) ->
+ [{?TCP_LISTENER(_ , _, LSock), _}]
+ = match(?TCP_LISTENER(Ref, ?ADDR, '_')),
+ LSock.
+
+match(Pat) ->
+ case diameter_reg:match(Pat) of
+ [] ->
+ ?WAIT(50),
+ match(Pat);
+ L ->
+ L
+ end.
+
+bin(sctp, #diameter_packet{bin = Bin}) ->
+ Bin;
+bin(tcp, Bin) ->
+ Bin.
+
+%% make_msg/0
+%%
+%% A valid Diameter message in as far as diameter_tcp examines it,
+%% the module examining the length in the Diameter header to locate
+%% message boundaries.
+
+make_msg() ->
+ N = 1024,
+ Bin = rand_bytes(4*N),
+ Len = 4*(N+1),
+ <<1:8, Len:24, Bin/binary>>.
+
+%% crypto:rand_bytes/1 isn't available on all platforms (since openssl
+%% isn't) so roll our own.
+rand_bytes(N) ->
+ random:seed(now()),
+ rand_bytes(N, <<>>).
+
+rand_bytes(0, Bin) ->
+ Bin;
+rand_bytes(N, Bin) ->
+ Oct = random:uniform(256) - 1,
+ rand_bytes(N-1, <<Oct, Bin/binary>>).
+
+%% ===========================================================================
+
+%% start_connect/3
+
+start_connect(Prot, PortNr, Ref) ->
+ {ok, TPid, [?ADDR]} = start_connect(Prot,
+ {connect, Ref},
+ ?SVC([]),
+ [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}]),
+ ?RECV(?TMSG({TPid, connected, _})),
+ TPid.
+
+start_connect(sctp, T, Svc, Opts) ->
+ diameter_sctp:start(T, Svc, [{sctp_initmsg, ?SCTP_INIT} | Opts]);
+start_connect(tcp, T, Svc, Opts) ->
+ diameter_tcp:start(T, Svc, Opts).
+
+%% start_accept/2
+%%
+%% Start transports sequentially by having each wait for a message
+%% from a job in a queue before commencing. Only one transport with
+%% a pending accept is started at a time since diameter_sctp currently
+%% assumes (and diameter currently implements) this.
+
+start_accept(Prot, Ref) ->
+ Pid = sync(accept, Ref),
+
+ %% Configure the same port number for transports on the same
+ %% reference.
+ PortNr = portnr(Prot, Ref),
+ {Mod, Opts} = tmod(Prot),
+
+ try
+ {ok, TPid, [?ADDR]} = Mod:start({accept, Ref},
+ ?SVC([?ADDR]),
+ [{port, PortNr} | Opts]),
+ ?RECV(?TMSG({TPid, connected})),
+ TPid
+ after
+ Pid ! Ref
+ end.
+
+sync(What, Ref) ->
+ ok = diameter_sync:cast({?MODULE, What, Ref},
+ [fun lock/2, Ref, self()],
+ infinity,
+ infinity),
+ receive {start, Ref, Pid} -> Pid end.
+
+lock(Ref, Pid) ->
+ Pid ! {start, Ref, self()},
+ erlang:monitor(process, Pid),
+ Ref = receive T -> T end.
+
+tmod(sctp) ->
+ {diameter_sctp, [{sctp_initmsg, ?SCTP_INIT}]};
+tmod(tcp) ->
+ {diameter_tcp, []}.
+
+portnr(sctp, Ref) ->
+ case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of
+ [{?SCTP_LISTENER(_, _, LSock), _}] ->
+ {ok, N} = inet:port(LSock),
+ N;
+ [] ->
+ 0
+ end;
+portnr(tcp, Ref) ->
+ case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of
+ [{?TCP_LISTENER(_, _, LSock), _}] ->
+ {ok, N} = inet:port(LSock),
+ N;
+ [] ->
+ 0
+ end.
+
+%% ===========================================================================
+
+%% gen_connect/3
+
+gen_connect(Prot, PortNr, Ref) ->
+ Pid = sync(connect, Ref),
+
+ %% Stagger connect attempts to avoid the situation that no
+ %% transport process is accepting yet.
+ receive after 250 -> ok end,
+
+ try
+ gen_connect(Prot, PortNr)
+ after
+ Pid ! Ref
+ end.
+
+gen_connect(sctp = P, PortNr) ->
+ {ok, Sock} = Ok = gen_sctp:open([{ip, ?ADDR}, {port, 0} | ?SCTP_OPTS]),
+ ok = gen_sctp:connect_init(Sock, ?ADDR, PortNr, []),
+ Ok = gen_accept(P, Sock);
+gen_connect(tcp, PortNr) ->
+ gen_tcp:connect(?ADDR, PortNr, ?TCP_OPTS).
+
+%% gen_listen/1
+
+gen_listen(sctp) ->
+ {ok, Sock} = gen_sctp:open([{ip, ?ADDR}, {port, 0} | ?SCTP_OPTS]),
+ {gen_sctp:listen(Sock, true), Sock};
+gen_listen(tcp) ->
+ gen_tcp:listen(0, [{ip, ?ADDR} | ?TCP_OPTS]).
+
+%% gen_accept/2
+
+gen_accept(sctp, Sock) ->
+ Assoc = ?RECV(?SCTP(Sock, {_, #sctp_assoc_change{state = comm_up,
+ outbound_streams = O,
+ inbound_streams = I,
+ assoc_id = A}}),
+ {O, I, A}),
+ putr(assoc, Assoc),
+ {ok, Sock};
+gen_accept(tcp, LSock) ->
+ gen_tcp:accept(LSock).
+
+%% gen_send/3
+
+gen_send(sctp, Sock, Bin) ->
+ {OS, _IS, Id} = getr(assoc),
+ {_, _, Us} = now(),
+ gen_sctp:send(Sock, Id, Us rem OS, Bin);
+gen_send(tcp, Sock, Bin) ->
+ gen_tcp:send(Sock, Bin).
+
+%% gen_recv/2
+
+gen_recv(sctp, Sock) ->
+ {_OS, _IS, Id} = getr(assoc),
+ ?RECV(?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = Id}], Bin}), Bin);
+gen_recv(tcp, Sock) ->
+ tcp_recv(Sock, <<>>).
+
+tcp_recv(_, <<_:8, Len:24, _/binary>> = Bin)
+ when Len =< size(Bin) ->
+ Bin;
+tcp_recv(Sock, B) ->
+ receive {tcp, Sock, Bin} -> tcp_recv(Sock, <<B/binary, Bin/binary>>) end.
+
+%% putr/2
+
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+%% getr/1
+
+getr(Key) ->
+ get({?MODULE, Key}).
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
new file mode 100644
index 0000000000..99f4fa1977
--- /dev/null
+++ b/lib/diameter/test/diameter_util.erl
@@ -0,0 +1,177 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_util).
+
+%%
+%% Utility functions.
+%%
+
+-export([consult/2,
+ run/1,
+ fold/3,
+ foldl/3,
+ scramble/1,
+ ps/0]).
+
+-define(L, atom_to_list).
+
+%% consult/2
+%%
+%% Extract info from the app/appup file (presumably) of the named
+%% application.
+
+consult(Name, Suf)
+ when is_atom(Name), is_atom(Suf) ->
+ case code:lib_dir(Name, ebin) of
+ {error = E, Reason} ->
+ {E, {Name, Reason}};
+ Dir ->
+ consult(filename:join([Dir, ?L(Name) ++ "." ++ ?L(Suf)]))
+ end.
+
+consult(Path) ->
+ case file:consult(Path) of
+ {ok, Terms} ->
+ Terms;
+ {error, Reason} ->
+ {error, {Path, Reason}}
+ end.
+%% Name/Path in the return value distinguish the errors and allow for
+%% a useful badmatch.
+
+%% run/1
+%%
+%% Evaluate functions in parallel and return a list of those that
+%% failed to return. The fun takes a boolean (did the function return
+%% or not), the function that was evaluated, the return value or exit
+%% reason and the prevailing accumulator.
+
+run(L) ->
+ fold(fun cons/4, [], L).
+
+cons(true, _, _, Acc) ->
+ Acc;
+cons(false, F, RC, Acc) ->
+ [{F, RC} | Acc].
+
+%% fold/3
+%%
+%% Parallel fold. Results are folded in the order received.
+
+fold(Fun, Acc0, L)
+ when is_function(Fun, 4) ->
+ Ref = make_ref(),
+ %% Spawn a middleman to collect down messages from processes
+ %% spawned for each function so as not to assume that all DOWN
+ %% messages are ours.
+ MRef = run1([fun fold/4, Ref, Fun, Acc0, L], Ref),
+ {Ref, RC} = down(MRef),
+ RC.
+
+fold(Ref, Fun, Acc0, L) ->
+ recv(run(Ref, L), Ref, Fun, Acc0).
+
+run(Ref, L) ->
+ [{run1(F, Ref), F} || F <- L].
+
+run1(F, Ref) ->
+ {_, MRef} = spawn_monitor(fun() -> exit({Ref, eval(F)}) end),
+ MRef.
+
+recv([], _, _, Acc) ->
+ Acc;
+recv(L, Ref, Fun, Acc) ->
+ {MRef, R} = down(),
+ {MRef, F} = lists:keyfind(MRef, 1, L),
+ recv(lists:keydelete(MRef, 1, L),
+ Ref,
+ Fun,
+ acc(R, Ref, F, Fun, Acc)).
+
+acc({Ref, RC}, Ref, F, Fun, Acc) ->
+ Fun(true, F, RC, Acc);
+acc(Reason, _, F, Fun, Acc) ->
+ Fun(false, F, Reason, Acc).
+
+down(MRef) ->
+ receive {'DOWN', MRef, process, _, Reason} -> Reason end.
+
+down() ->
+ receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end.
+
+%% foldl/3
+%%
+%% Parallel fold. Results are folded in order of the function list.
+
+foldl(Fun, Acc0, L)
+ when is_function(Fun, 4) ->
+ Ref = make_ref(),
+ recvl(run(Ref, L), Ref, Fun, Acc0).
+
+recvl([], _, _, Acc) ->
+ Acc;
+recvl([{MRef, F} | L], Ref, Fun, Acc) ->
+ R = down(MRef),
+ recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)).
+
+%% scramble/1
+%%
+%% Sort a list into random order.
+
+scramble(L) ->
+ foldl(fun(true, _, S, false) -> S end,
+ false,
+ [[fun s/1, L]]).
+
+s(L) ->
+ random:seed(now()),
+ s([], L).
+
+s(Acc, []) ->
+ Acc;
+s(Acc, L) ->
+ {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L),
+ s([T|Acc], H ++ Rest).
+
+%% ps/0
+
+ps() ->
+ [{P, process_info(P)} || P <- erlang:processes()].
+
+%% eval/1
+
+eval({M,[F|A]})
+ when is_atom(F) ->
+ apply(M,F,A);
+
+eval({M,F,A}) ->
+ apply(M,F,A);
+
+eval([F|A])
+ when is_function(F) ->
+ apply(F,A);
+
+eval(L)
+ when is_list(L) ->
+ run(L);
+
+eval(F)
+ when is_function(F,0) ->
+ F().
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
new file mode 100644
index 0000000000..dec307529a
--- /dev/null
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -0,0 +1,540 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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
+%% 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 online 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the RFC3539 watchdog state machine as implemented by
+%% module diameter_watchdog.
+%%
+
+-module(diameter_watchdog_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([reopen/1, reopen/4]).
+
+-export([start/3, %% diameter_transport callback
+ id/1, %% jitter callback
+ run/1]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(BASE, diameter_gen_base_rfc3588).
+-define(APPL_ID, diameter_gen_base_rfc3588:id()).
+-define(SUCCESS, 2001). %% DIAMETER_SUCCESS
+
+%% Addresses for the local and remote diameter nodes. The values don't
+%% matter since we're faking transport.
+-define(LOCALHOST, {127,0,0,1}).
+-define(REMOTEHOST, {10,0,0,1}).
+
+-define(CAPS, #diameter_caps{origin_host = "node.innan.com",
+ origin_realm = "innan.com",
+ host_ip_address = [?LOCALHOST],
+ vendor_id = 1022,
+ product_name = "remote",
+ auth_application_id = [?APPL_ID]}).
+
+-define(APPL, #diameter_app{alias = ?MODULE,
+ dictionary = ?BASE,
+ module = [?MODULE],
+ init_state = now(),
+ id = ?APPL_ID,
+ mutable = false}).
+
+%% Service record maintained by our faked service process.
+-define(SERVICE, #diameter_service{pid = self(),
+ capabilities = ?CAPS,
+ applications = [?APPL]}).
+
+%% Watchdog timer as a callback.
+-define(WD(T), {?MODULE, id, [T]}).
+
+%% Watchdog timers used by the testcases. Note that the short timeout
+%% with random jitter is excluded since the reopen/1 isn't smart
+%% enough to deal with it: see ONE_WD below.
+-define(WD_TIMERS, [?WD(6000)
+ | [F_(T_) || T_ <- [10000, 20000, 30000],
+ F_ <- [fun(T__) -> T__ end,
+ fun(T__) -> ?WD(T__) end]]]).
+
+%% Transport types.
+-define(TRANSPORTS, [connect, accept]).
+
+%% Message over the transport interface.
+-define(TMSG(T), {diameter, T}).
+
+%% Receive a message within a specified time.
+-define(RECV(T, Timeout),
+ receive T -> now()
+ after Timeout -> ?ERROR({timeout, Timeout})
+ end).
+
+%% Receive a message in a given number of watchdogs, plus or minus
+%% half. Note that the call to now_diff assumes left to right
+%% evaluation order.
+-define(RECV(T, N, WdL, WdH),
+ [?ERROR({received, _Elapsed_, _LowerBound_, N, WdL})
+ || _UpperBound_ <- [(N)*(WdH) + (WdH) div 2],
+ _Elapsed_ <- [now_diff(now(), ?RECV(T, _UpperBound_))],
+ _LowerBound_ <- [(N)*(WdL) - (WdL) div 2],
+ _Elapsed_ =< _LowerBound_*1000]).
+
+%% A timeout that ensures one watchdog. The ensure only one watchdog
+%% requires (Wd + 2000) + 1000 < 2*(Wd - 2000) ==> 7000 < Wd for the
+%% case with random jitter.
+-define(ONE_WD(Wd), jitter(Wd,2000) + 1000).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {minutes, 6}}].%% enough for 11 watchdogs @ 30 sec plus jitter
+
+all() ->
+ [reopen].
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+%% # reopen/1
+%% ===========================================================================
+
+%% Test the watchdog state machine for the required failover, failback
+%% and reopen behaviour. Do this by having the testcase replace
+%% diameter_service and start watchdogs, and having this module
+%% implement a transport process that plays the role of the peer
+%% Diameter node.
+
+reopen(_) ->
+ [] = ?util:run([{?MODULE, [run, [reopen, Wd, T, N, M]]}
+ || Wd <- ?WD_TIMERS,
+ T <- ?TRANSPORTS,
+ N <- [0,1,2],
+ M <- ['DWR', 'DWA', other]]).
+
+reopen(Wd, Type, N, What) ->
+ Ref = make_ref(),
+
+ %% The maker of transport processes.
+ TPid = start({N, Wd, What, Ref}),
+
+ %% Act like diameter_service and start the watchdog process, which
+ %% in turn starts a peer_fsm process, which in turn starts a
+ %% transport process by way of start/3. Messages received by the
+ %% testcase are those sent by diameter_watchdog to the service
+ %% process (= process starting the watchdog).
+ WPid1 = watchdog(Type, Ref, TPid, Wd),
+
+ %% Low/high watchdog timeouts.
+ WdL = jitter(Wd, -2000),
+ WdH = jitter(Wd, 2000),
+
+ %% Connection should come up immediately as a consequence of
+ %% starting the watchdog process. In the accepting case this
+ %% results in a new watchdog on a transport waiting for a new
+ %% connection.
+ ?RECV({connection_up, WPid1, _}, 1000),
+
+ WPid2 = case Type of
+ connect ->
+ WPid1;
+ accept ->
+ watchdog(Type, Ref, TPid, Wd)
+ end,
+
+ %% OKAY Timer expires & Failover()
+ %% Pending SetWatchdog() SUSPECT
+ %%
+ %% Since our transport is replying to N DWR's before becoming
+ %% silent, we should go down after N+2 watchdog_timer expirations:
+ %% that is, after the first unanswered DWR. Knowing the min/max
+ %% watchdog timeout values gives the time interval in which the
+ %% down message is expected.
+ ?RECV({connection_down, WPid1}, N+2, WdL, WdH),
+
+ %% SUSPECT Receive DWA Pending = FALSE
+ %% Failback()
+ %% SetWatchdog() OKAY
+ %%
+ %% SUSPECT Receive non-DWA Failback()
+ %% SetWatchdog() OKAY
+ %%
+ %% The transport receives a message before the expiry of another
+ %% watchdog to induce failback.
+ ?RECV({connection_up, WPid1}, WdH),
+
+ %% OKAY Timer expires & SendWatchdog()
+ %% !Pending SetWatchdog()
+ %% Pending = TRUE OKAY
+ %%
+ %% OKAY Timer expires & Failover()
+ %% Pending SetWatchdog() SUSPECT
+ %%
+ %% The transport is still not responding to watchdogs so the
+ %% connection should go back down after either one or two watchdog
+ %% expiries, depending on whether or not DWA restored the connection.
+ F = choose(What == 'DWA', 2, 1),
+ ?RECV({connection_down, WPid1}, F, WdL, WdH),
+
+ %% SUSPECT Timer expires CloseConnection()
+ %% SetWatchdog() DOWN
+ %%
+ %% DOWN Timer expires AttemptOpen()
+ %% SetWatchdog() DOWN
+ %%
+ %% Our transport tells us when the fake connection is
+ %% reestablished, which should happen after another couple of
+ %% watchdog expiries, the first bringing the watchdog to state
+ %% DOWN, the second triggering an attempt to reopen the
+ %% connection.
+ ?RECV({reopen, Ref}, 2, WdL, WdH),
+
+ %% DOWN Connection up NumDWA = 0
+ %% SendWatchdog()
+ %% SetWatchdog()
+ %% Pending = TRUE REOPEN
+ %%
+ %% REOPEN Receive DWA & Pending = FALSE
+ %% NumDWA < 2 NumDWA++ REOPEN
+ %%
+ %% REOPEN Receive DWA & Pending = FALSE
+ %% NumDWA == 2 NumDWA++
+ %% Failback() OKAY
+ %%
+ %% Now the watchdog should require three received DWA's before
+ %% taking the connection back up. The first DWR is sent directly
+ %% after capabilities exchange so it should take no more than two
+ %% watchdog expiries.
+ ?RECV({connection_up, WPid2, _}, 2, WdL, WdH).
+
+%% ===========================================================================
+
+%% Start the fake transport process. From diameter's point of view
+%% it's started when diameter calls start/3. We start it before this
+%% happens since we use the same fake transport each time diameter
+%% calls start/3. The process lives and dies with the test case.
+start(Config) ->
+ Pid = self(),
+ spawn(fun() -> loop(init(Pid, Config)) end).
+
+%% Transport start from diameter. This may be called multiple times
+%% depending on the testcase.
+start({Type, _Ref}, #diameter_service{}, Pid) ->
+ Ref = make_ref(),
+ MRef = erlang:monitor(process, Pid),
+ Pid ! {start, self(), Type, Ref},
+ {Ref, TPid} = receive
+ {Ref, _} = T ->
+ T;
+ {'DOWN', MRef, process, _, _} = T ->
+ T
+ end,
+ erlang:demonitor(MRef, [flush]),
+ {ok, TPid}.
+
+%% id/1
+
+id(T) ->
+ T.
+
+%% ===========================================================================
+
+choose(true, X, _) -> X;
+choose(false, _, X) -> X.
+
+%% run/1
+%%
+%% A more useful badmatch in case of failure.
+
+run([F|A]) ->
+ ok = try
+ apply(?MODULE, F, A),
+ ok
+ catch
+ E:R ->
+ {A, E, R, erlang:get_stacktrace()}
+ end.
+
+%% now_diff/2
+
+now_diff(T1, T2) ->
+ timer:now_diff(T2, T1).
+
+%% jitter/2
+
+jitter(?WD(T), _) ->
+ T;
+jitter(T,D) ->
+ T+D.
+
+%% watchdog/4
+%%
+%% Fake the call from diameter_service. The watchdog process will send
+%% messages to the calling "service" process so our tests are that the
+%% watchdog responds as expected.
+
+watchdog(Type, Ref, TPid, Wd) ->
+ Opts = [{transport_module, ?MODULE},
+ {transport_config, TPid},
+ {watchdog_timer, Wd}],
+ monitor(diameter_watchdog:start({Type, Ref},
+ {false, Opts, false, ?SERVICE})).
+
+monitor(Pid) ->
+ erlang:monitor(process, Pid),
+ Pid.
+
+%% ===========================================================================
+
+%% Transport process implmentation. Fakes reception of messages by
+%% sending fakes to the parent (peer fsm) process that called start/3.
+
+-record(transport,
+ {type, %% connect | accept | manager
+ parent, %% pid() of peer_fsm/ervice process
+ open = false, %% done with capabilities exchange?
+ config}).%% testcase-specific config
+
+%% init/2
+
+%% Testcase starting the manager.
+init(SvcPid, {_,_,_,_} = Config) ->
+ putr(peer, [{'Origin-Host', hostname() ++ ".utan.com"},
+ {'Origin-Realm', "utan.com"}]),
+ #transport{type = manager,
+ parent = monitor(SvcPid),
+ config = Config};
+
+%% Manager starting a transport.
+init(_, {Type, ParentPid, SvcPid, TwinPid, Peer, {N,_,_,_} = Config}) ->
+ putr(peer, Peer),
+ putr(service, SvcPid),
+ putr(count, init(Type, ParentPid, TwinPid, N)),%% number of DWR's to answer
+ #transport{type = Type,
+ parent = monitor(ParentPid),
+ config = Config}.
+
+init(Type, ParentPid, undefined, N) ->
+ connected(ParentPid, Type),
+ N;
+init(_, _, TPid, _) ->
+ monitor(TPid),
+ 3.
+
+%% Generate a unique hostname for the faked peer.
+hostname() ->
+ lists:flatten(io_lib:format("~p-~p-~p", tuple_to_list(now()))).
+
+%% loop/1
+
+loop(S) ->
+ loop(msg(receive T -> T end, S)).
+
+msg(T,S) ->
+ case transition(T,S) of
+ ok ->
+ S;
+ #transport{} = NS ->
+ NS;
+ {stop, Reason} ->
+ x(Reason)
+ end.
+
+x(Reason) ->
+ exit(Reason).
+
+%% transition/2
+
+%% Manager is being asked for a new transport process.
+transition({start, Pid, Type, Ref}, #transport{type = manager,
+ parent = SvcPid,
+ config = Config}) ->
+ TPid = start({Type, Pid, SvcPid, getr(transport), getr(peer), Config}),
+ Pid ! {Ref, TPid},
+ putr(transport, TPid),
+ ok;
+
+%% Peer fsm or testcase process has died.
+transition({'DOWN', _, process, Pid, _} = T, #transport{parent = Pid}) ->
+ {stop, T};
+
+%% Twin transport process has gone down. In the connect case, the
+%% transport isn't started until this happens in the first place so
+%% connect immediately. In the accept case, fake the peer reconnecting
+%% only after another watchdog expiry.
+transition({'DOWN', _, process, _, _}, #transport{type = Type,
+ config = {_, Wd, _, _}}) ->
+ Tmo = case Type of
+ connect ->
+ 0;
+ accept ->
+ ?ONE_WD(Wd)
+ end,
+ erlang:send_after(Tmo, self(), reconnect),
+ ok;
+
+transition(reconnect, #transport{type = Type,
+ parent = Pid,
+ config = {_,_,_,Ref}}) ->
+ getr(service) ! {reopen, Ref},
+ connected(Pid, Type),
+ ok;
+
+%% Peer fsm process is sending CER: fake the peer's CEA.
+transition(?TMSG({send, Bin}), #transport{type = connect,
+ open = false,
+ parent = Pid}
+ = S) ->
+ {Code, Flags, _} = ?BASE:msg_header('CER'),
+ <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
+ Hdr = make_header(Bin),
+ recv(Pid, {Hdr, make_cea()}),
+ S#transport{open = true};
+
+%% Peer fsm process is sending CEA.
+transition(?TMSG({send, Bin}), #transport{type = accept,
+ open = false}
+ = S) ->
+ {Code, Flags, _} = ?BASE:msg_header('CEA'),
+ <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
+ S#transport{open = true};
+
+%% Watchdog is sending DWR or DWA.
+transition(?TMSG({send, Bin}), #transport{open = true} = S) ->
+ {Code, _, _} = ?BASE:msg_header('DWR'),
+ {Code, _, _} = ?BASE:msg_header('DWA'),
+ <<_:32, R:1, 0:7, Code:24, _:96, _/binary>> = Bin,
+ Hdr = make_header(Bin),
+ dwa(1 == R, S, Hdr),
+ ok;
+
+%% We're telling ourselves to fake a received message.
+transition({recv, Msg}, #transport{parent = Pid}) ->
+ recv(Pid, Msg),
+ ok;
+
+%% We're telling ourselves to receive a message to induce failback.
+transition(failback = T, #transport{parent = Pid}) ->
+ recv(Pid, eraser(T)),
+ ok.
+
+make_header(Bin) ->
+ #diameter_header{end_to_end_id = E,
+ hop_by_hop_id = H}
+ = diameter_codec:decode_header(Bin),
+ #diameter_header{end_to_end_id = E,
+ hop_by_hop_id = H}.
+
+recv(Pid, Msg) ->
+ Pid ! ?TMSG({recv, encode(Msg)}).
+
+%% Replace the end-to-end/hop-by-hop identifiers with those from an
+%% incoming request to which we're constructing a reply.
+encode({Hdr, [_|_] = Msg}) ->
+ #diameter_header{hop_by_hop_id = HBH,
+ end_to_end_id = E2E}
+ = Hdr,
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
+ <<H:12/binary, _:64, T/binary>> = Bin,
+ <<H/binary, HBH:32, E2E:32, T/binary>>;
+
+encode([_|_] = Msg) ->
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
+ Bin.
+
+connected(Pid, connect) ->
+ Pid ! ?TMSG({self(), connected, make_ref()});
+connected(Pid, accept) ->
+ Pid ! ?TMSG({self(), connected}),
+ recv(Pid, make_cer()).
+
+make_cer() ->
+ ['CER' | getr(peer)] ++ [{'Host-IP-Address', [?REMOTEHOST]},
+ {'Vendor-Id', 1028},
+ {'Product-Name', "Utan"},
+ {'Auth-Application-Id', [?APPL_ID]}].
+
+make_cea() ->
+ ['CER' | Rest] = make_cer(),
+ ['CEA', {'Result-Code', ?SUCCESS} | Rest].
+
+make_dwr() ->
+ ['DWR' | getr(peer)].
+
+make_dwa() ->
+ ['DWR' | Rest] = make_dwr(),
+ ['DWA', {'Result-Code', ?SUCCESS} | Rest].
+
+dwa(false, _, _) -> %% outgoing was DWA ...
+ ok;
+dwa(true, S, Hdr) -> %% ... or DWR
+ dwa(getr(count), Hdr, S);
+
+%% React to the DWR only after another watchdog expiry. We shouldn't
+%% get another DWR while the answer is pending.
+dwa(0, Hdr, #transport{config = {_, Wd, What, _}}) ->
+ erlang:send_after(?ONE_WD(Wd), self(), failback),
+ putr(failback, make_msg(What, Hdr)),
+ eraser(count);
+
+dwa(undefined, _, _) ->
+ undefined = getr(failback), %% ensure this is after failback
+ ok;
+
+%% Reply with DWA.
+dwa(N, Hdr, #transport{parent = Pid}) ->
+ putr(count, N-1),
+ recv(Pid, {Hdr, make_dwa()}).
+
+%% Answer to received DWR.
+make_msg('DWA', Hdr) ->
+ {Hdr, make_dwa()};
+
+%% DWR from peer.
+make_msg('DWR', _) ->
+ make_dwr();
+
+%% An unexpected answer is discarded after passing through the
+%% watchdog state machine.
+make_msg(other, _) ->
+ ['RAA', {'Session-Id', diameter:session_id("abc")},
+ {'Result-Code', 2001}
+ | getr(peer)].
+
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
+eraser(Key) ->
+ erase({?MODULE, Key}).
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index ddc720d0c1..c6f709dc36 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -17,31 +17,24 @@
#
# %CopyrightEnd%
-TEST_SPEC_FILE = diameter.spec
-
+TEST_SPEC_FILE = diameter.spec
COVER_SPEC_FILE = diameter.cover
-BEHAVIOUR_MODULES =
-
MODULES = \
- $(BEHAVIOUR_MODULES) \
- diameter_SUITE \
- diameter_app_test \
- diameter_appup_test \
- diameter_compiler_test \
- diameter_config_test \
- diameter_peer_test \
- diameter_reg_test \
- diameter_session_test \
- diameter_stats_test \
- diameter_sync_test \
- diameter_tcp_test \
- diameter_test_lib \
- diameter_test_server
-
+ diameter_ct \
+ diameter_util \
+ diameter_enum \
+ diameter_codec_SUITE \
+ diameter_codec_test \
+ diameter_app_SUITE \
+ diameter_dict_SUITE \
+ diameter_reg_SUITE \
+ diameter_sync_SUITE \
+ diameter_stats_SUITE \
+ diameter_watchdog_SUITE \
+ diameter_transport_SUITE \
+ diameter_traffic_SUITE \
+ diameter_relay_SUITE
INTERNAL_HRL_FILES = \
- diameter_test_lib.hrl
-
-
-
+ diameter_ct.hrl
diff --git a/lib/diameter/test/slask/diameter_persistent_table_test.erl b/lib/diameter/test/slask/diameter_persistent_table_test.erl
deleted file mode 100644
index bb907a5777..0000000000
--- a/lib/diameter/test/slask/diameter_persistent_table_test.erl
+++ /dev/null
@@ -1,495 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. 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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Verify the persistent-table component of the Diameter application
-%%----------------------------------------------------------------------
-%%
--module(diameter_persistent_table_test).
-
--export([
- init_per_testcase/2, fin_per_testcase/2,
-
- all/1,
- suite_init/1, suite_fin/1,
-
- simple_start_and_stop/1,
- table_create_and_delete/1
-
- ]).
-
--export([t/0, t/1]).
-
--include("diameter_test_lib.hrl").
-
--record(command, {id, desc, cmd, verify}).
-
-
-t() -> diameter_test_server:t(?MODULE).
-t(Case) -> diameter_test_server:t({?MODULE, Case}).
-
-
-%% Test server callbacks
-init_per_testcase(Case, Config) ->
- diameter_test_server:init_per_testcase(Case, Config).
-
-fin_per_testcase(Case, Config) ->
- diameter_test_server:fin_per_testcase(Case, Config).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) ->
- Cases =
- [
- simple_start_and_stop,
- table_create_and_delete
- ],
- {req, [], {conf, suite_init, Cases, suite_fin}}.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite_init(suite) -> [];
-suite_init(doc) -> [];
-suite_init(Config) when is_list(Config) ->
- Config.
-
-
-suite_fin(suite) -> [];
-suite_fin(doc) -> [];
-suite_fin(Config) when is_list(Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Test case(s)
-%%
-
-simple_start_and_stop(suite) ->
- [];
-simple_start_and_stop(doc) ->
- [];
-simple_start_and_stop(Config) when is_list(Config) ->
- diameter:enable_trace(100, io),
- case diameter_persistent_table:start_link() of
- {ok, Pid} ->
- unlink(Pid);
- {error, Reason} ->
- exit({failed_starting, Reason})
- end,
-
- ok = diameter_persistent_table:stop(),
- ok.
-
-
-table_create_and_delete(suite) ->
- [];
-table_create_and_delete(doc) ->
- [];
-table_create_and_delete(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
-
- %% Command range values
- Initial = 100,
- ClientCreation = 200,
- Nice = 300,
- Evil = 400,
- End = 500,
-
- Verbosity = min,
- %% Verbosity = max,
-
- Data01 = lists:sort([{a, 10}, {b, 20}, {c, 30}]),
- Data02 = lists:sort([{x, 100}, {y, 200}, {z, 300}]),
-
- Commands =
- [
- %% Initial commands
- initial_command( Initial + 0,
- "enable trace",
- fun() -> diameter:enable_trace(Verbosity, io) end,
- ok),
- initial_command( Initial + 1,
- "start persistent-table process",
- fun() ->
- case diameter_persistent_table:start_link() of
- {ok, Pid} when is_pid(Pid) ->
- ok;
- Error ->
- Error
- end
- end,
- ok),
-
- client_create_command( ClientCreation + 1,
- "1",
- client01),
-
- client_create_command( ClientCreation + 2,
- "2",
- client02),
-
- nice_command( Nice + 1,
- "client 1 create table 1",
- fun() ->
- create_table(client01, tab01, []),
- diameter_persistent_table:which_tables()
- end,
- fun([tab01] = Tabs) ->
- {ok, Tabs};
- (Unexpected) ->
- {error, {bad_tables, Unexpected}}
- end),
-
- nice_command( Nice + 2,
- "client 1 create table 2",
- fun() ->
- create_table(client01, tab02, []),
- diameter_persistent_table:which_tables()
- end,
- fun([tab01, tab02] = Tabs) ->
- {ok, Tabs};
- ([tab02, tab01] = Tabs) ->
- {ok, Tabs};
- (Unexpected) ->
- {error, {bad_tables, Unexpected}}
- end),
-
- nice_command( Nice + 3,
- "client 2 create table 1",
- fun() ->
- create_table(client02, tab03, []),
- diameter_persistent_table:which_tables(whereis(client02))
- end,
- fun([tab03] = Tabs) ->
- {ok, Tabs};
- (Unexpected) ->
- {error, {bad_tables, Unexpected}}
- end),
-
- nice_command( Nice + 4,
- "client 1 delete table 1",
- fun() ->
- delete_table(client01, tab01),
- diameter_persistent_table:which_tables(whereis(client01))
- end,
- fun([tab02] = Tabs) ->
- {ok, Tabs};
- (Unexpected) ->
- {error, {bad_tables, Unexpected}}
- end),
-
- nice_command( Nice + 5,
- "client 1 fill in some data in tab02",
- fun() ->
- populate_table(client01, tab02, Data01),
- lists:sort(ets:tab2list(tab02))
- end,
- fun(Data) when Data =:= Data01 ->
- {ok, Data};
- (Unexpected) ->
- {error, {bad_data, Unexpected}}
- end),
-
- nice_command( Nice + 6,
- "client 2 fill in some data in tab03",
- fun() ->
- populate_table(client02, tab03, Data02),
- lists:sort(ets:tab2list(tab03))
- end,
- fun(Data) when Data =:= Data02 ->
- {ok, Data};
- (Unexpected) ->
- {error, {bad_data, Unexpected}}
- end),
-
- nice_command( Nice + 7,
- "simulate client 1 crash",
- fun() ->
- simulate_crash(client01)
- end,
- fun(ok) ->
- {ok, crashed};
- (Unexpected) ->
- {error, {bad_simulation_result, Unexpected}}
- end),
-
- client_create_command( Nice + 8,
- "1 restarted",
- client01),
-
- nice_command( Nice + 9,
- "client 1 create tab02 - verify data",
- fun() ->
- create_table(client01, tab02, []),
- lists:sort(ets:tab2list(tab02))
- end,
- fun(Data) when Data =:= Data01 ->
- {ok, Data};
- (Unexpected) ->
- {error, {bad_data, Unexpected}}
- end),
-
- evil_command( Evil + 1,
- "try (and fail) to delete the non-existing table tab04",
- fun() ->
- delete_table(client02, tab04)
- end,
- fun({error, {unknown_table, tab04}}) ->
- {ok, tab04};
- (X) ->
- {error, {bad_result, X}}
- end),
-
- evil_command( Evil + 2,
- "try (and fail) to delete a not owned table tab02",
- fun() ->
- delete_table(client02, tab02)
- end,
- fun({error, {not_owner, tab02}}) ->
- {ok, tab02};
- (X) ->
- {error, {bad_result, X}}
- end),
-
- evil_command( Evil + 3,
- "try (and fail) to create an already existing *and* owned table - tab03",
- fun() ->
- create_table(client02, tab03, [])
- end,
- fun({error, {already_owner, tab03}}) ->
- {ok, tab03};
- (X) ->
- {error, {bad_result, X}}
- end),
-
- evil_command( Evil + 4,
- "try (and fail) to create an already existing not owned table - tab02",
- fun() ->
- create_table(client02, tab02, [])
- end,
- fun({error, {not_owner, _Owner, tab02}}) ->
- {ok, tab02};
- (X) ->
- {error, {bad_result, X}}
- end),
-
- end_command( End + 1,
- "stop client01",
- fun() -> stop_client(client01) end),
-
- end_command( End + 2,
- "stop client02",
- fun() -> stop_client(client02) end),
-
- end_command( End + 2,
- "stop persistent-table",
- fun() -> diameter_persistent_table:stop() end),
-
- evil_command( Evil + 5,
- "try (and fail) to stop a not running persistent-table process",
- fun() ->
- diameter_persistent_table:stop()
- end,
- fun({'EXIT', {noproc, _}}) ->
- {ok, not_running};
- (X) ->
- {error, {bad_result, X}}
- end)
-
- ],
-
- exec(Commands).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%
-%% Command engine
-%%
-
-exec([]) ->
- ok;
-exec([#command{id = No,
- desc = Desc,
- cmd = Cmd,
- verify = Verify}|Commands]) ->
- io:format("Executing command ~2w: ~s: ", [No, Desc]),
- case (catch Verify((catch Cmd()))) of
- {ok, OK} ->
- io:format("ok => ~p~n", [OK]),
- exec(Commands);
- {error, Reason} ->
- io:format("error => ~p~n", [Reason]),
- {error, {bad_result, No, Reason}};
- Error ->
- io:format("exit => ~p~n", [Error]),
- {error, {unexpected_result, No, Error}}
- end.
-
-initial_command(No, Desc0, Cmd, VerifyVal) when is_function(Cmd) ->
- Desc = lists:flatten(io_lib:format("Initial - ~s", [Desc0])),
- command(No, Desc, Cmd, VerifyVal).
-
-client_create_command(No, Desc0, Name) ->
- Desc = lists:flatten(io_lib:format("Client create - ~s", [Desc0])),
- Self = self(),
- Cmd = fun() -> start_client(Self, Name) end,
- command(No, Desc, Cmd, ok).
-
-nice_command(No, Desc0, Cmd, Verify)
- when is_function(Cmd) andalso is_function(Verify) ->
- Desc = lists:flatten(io_lib:format("Nice - ~s", [Desc0])),
- command(No, Desc, Cmd, Verify).
-
-evil_command(No, Desc0, Cmd, Verify)
- when is_function(Cmd) andalso is_function(Verify) ->
- Desc = lists:flatten(io_lib:format("Evil - ~s", [Desc0])),
- command(No, Desc, Cmd, Verify).
-
-end_command(No, Desc0, Cmd) when is_function(Cmd) ->
- Desc = lists:flatten(io_lib:format("End - ~s", [Desc0])),
- command(No, Desc, Cmd, ok).
-
-command(No, Desc, Cmd, Verify)
- when (is_integer(No) andalso
- is_list(Desc) andalso
- is_function(Cmd) andalso
- is_function(Verify)) ->
- #command{id = No,
- desc = Desc,
- cmd = Cmd,
- verify = Verify};
-command(No, Desc, Cmd, VerifyVal)
- when (is_integer(No) andalso
- is_list(Desc) andalso
- is_function(Cmd)) ->
- Verify =
- fun(Val) ->
- case Val of
- VerifyVal ->
- {ok, Val};
- _ ->
- {error, Val}
- end
- end,
- #command{id = No,
- desc = Desc,
- cmd = Cmd,
- verify = Verify}.
-
-
-start_client(Parent, Name) ->
- ClientPid = spawn_link(fun() -> client_init(Parent, Name) end),
- receive
- {ClientPid, started} ->
- ClientPid,
- ok;
- {'EXIT', ClientPid, Reason} ->
- {error, {failed_starting_client, Reason}}
- end.
-
-stop_client(Client) ->
- Pid = whereis(Client),
- Pid ! stop,
- receive
- {'EXIT', Pid, normal} ->
- ok
- end.
-
-create_table(Client, Tab, Opts) ->
- Self = self(),
- Pid = whereis(Client),
- Pid ! {create_table, Tab, Opts, Self},
- receive
- {Pid, created} ->
- ok;
- {Pid, {create_failed, Error}} ->
- Error
- end.
-
-delete_table(Client, Tab) ->
- Self = self(),
- Pid = whereis(Client),
- Pid ! {delete_table, Tab, Self},
- receive
- {Pid, deleted} ->
- ok;
- {Pid, {delete_failed, Error}} ->
- Error
- end.
-
-populate_table(Client, Tab, Data) ->
- Self = self(),
- Pid = whereis(Client),
- Pid ! {populate_table, Tab, Data, Self},
- receive
- {Pid, populated} ->
- ok
- end.
-
-simulate_crash(Client) ->
- Pid = whereis(Client),
- Pid ! simulate_crash,
- receive
- {'EXIT', Pid, simulated_crash} ->
- ok
- end.
-
-client_init(Parent, Name) ->
- erlang:register(Name, self()),
- process_flag(trap_exit, true),
- Parent ! {self(), started},
- client_loop().
-
-client_loop() ->
- receive
- stop ->
- exit(normal);
-
- {create_table, T, Opts, From} when is_atom(T) andalso is_list(Opts) ->
- case diameter_persistent_table:create(T, Opts) of
- ok ->
- From ! {self(), created};
- Error ->
- From ! {self(), {create_failed, Error}}
- end,
- client_loop();
-
- {delete_table, T, From} ->
- case diameter_persistent_table:delete(T) of
- ok ->
- From ! {self(), deleted};
- Error ->
- From ! {self(), {delete_failed, Error}}
- end,
- client_loop();
-
- {populate_table, Tab, Data, From} ->
- ets:insert(Tab, Data),
- From ! {self(), populated},
- client_loop();
-
- simulate_crash ->
- exit(simulated_crash)
- end.
-