Merge branch 'anders/diameter/timetraps/OTP-10914' into maint

* anders/diameter/timetraps/OTP-10914:
  Add examples testcase to help identify timetrap failures
  Minor traffic suite fix
  Add gen_tcp suite
  Lighten up on suite timetraps
  Add more information to traffic suite timeout failures

7 files changed, 170 insertions, 33 deletions

diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
index 209f72adf1..1e262895a6 100644
--- a/lib/diameter/test/diameter_app_SUITE.erl
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -56,7 +56,7 @@
 %% ===========================================================================
 
 suite() ->
-    [{timetrap, {seconds, 10}}].
+    [{timetrap, {seconds, 60}}].
 
 all() ->
     [keys,
diff --git a/lib/diameter/test/diameter_distribution_SUITE.erl b/lib/diameter/test/diameter_distribution_SUITE.erl
index 01d3507b27..f069abbe2f 100644
--- a/lib/diameter/test/diameter_distribution_SUITE.erl
+++ b/lib/diameter/test/diameter_distribution_SUITE.erl
@@ -28,7 +28,7 @@
          all/0]).
 
 %% testcases
--export([enslave/1,
+-export([enslave/1, enslave/0,
          ping/1,
          start/1,
          connect/1,
@@ -36,7 +36,7 @@
          send_remote/1,
          send_timeout/1,
          send_failover/1,
-         stop/1]).
+         stop/1, stop/0]).
 
 %% diameter callbacks
 -export([peer_up/3,
@@ -126,6 +126,9 @@ all() ->
 %% Start four slave nodes, one to implement a Diameter server,
 %% two three to implement a client.
 
+enslave() ->
+    [{timetrap, {seconds, 30*length(?NODES)}}].
+
 enslave(Config) ->
     Here = filename:dirname(code:which(?MODULE)),
     Ebin = filename:join([Here, "..", "ebin"]),
@@ -225,6 +228,9 @@ connect(Config) ->
 %%
 %% Stop the slave nodes.
 
+stop() ->
+    [{timetrap, {seconds, 30*length(?NODES)}}].
+
 stop(_Config) ->
     [] = [{N,E} || {N,_} <- ?NODES,
                    {error, _, _} = E <- [ct_slave:stop(N)]].
diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl
index 585fc9d3b8..1954bc319b 100644
--- a/lib/diameter/test/diameter_examples_SUITE.erl
+++ b/lib/diameter/test/diameter_examples_SUITE.erl
@@ -29,6 +29,7 @@
 %% testcases
 -export([dict/1, dict/0,
          code/1,
+         slave/1, slave/0,
          enslave/1,
          start/1,
          traffic/1,
@@ -65,11 +66,12 @@
 %% ===========================================================================
 
 suite() ->
-    [{timetrap, {seconds, 45}}].
+    [{timetrap, {minutes, 2}}].
 
 all() ->
     [dict,
      code,
+     slave,
      enslave,
      start,
      traffic,
@@ -250,6 +252,29 @@ store(Path, Dict) ->
 
 %% ===========================================================================
 
+%% slave/1
+%%
+%% Return how long slave start/stop is taking since it seems to be
+%% ridiculously long on some hosts.
+
+slave() ->
+    [{timetrap, {minutes, 10}}].
+
+slave(_) ->
+    T0 = now(),
+    {ok, Node} = ct_slave:start(?MODULE, ?TIMEOUTS),
+    T1 = now(),
+    T2 = rpc:call(Node, erlang, now, []),
+    {ok, Node} = ct_slave:stop(?MODULE),
+    now_diff([T0, T1, T2, now()]).
+
+now_diff([T1,T2|_] = Ts) ->
+    [timer:now_diff(T2,T1) | now_diff(tl(Ts))];
+now_diff(_) ->
+    [].
+
+%% ===========================================================================
+
 %% enslave/1
 %%
 %% Start two nodes: one for the server, one for the client.
diff --git a/lib/diameter/test/diameter_gen_tcp_SUITE.erl b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
new file mode 100644
index 0000000000..7e232edb44
--- /dev/null
+++ b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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%
+%%
+
+%%
+%% Some gen_sctp-specific tests demonstrating problems that were
+%% encountered during diameter development but have nothing
+%% specifically to do with diameter. At least one of them can cause
+%% diameter_traffic_SUITE testcases to fail.
+%%
+
+-module(diameter_gen_tcp_SUITE).
+
+-export([suite/0,
+         all/0]).
+
+%% testcases
+-export([send_long/1]).
+
+-define(LOOPBACK, {127,0,0,1}).
+-define(GEN_OPTS, [binary, {active, true}, {ip, ?LOOPBACK}]).
+
+%% ===========================================================================
+
+suite() ->
+    [{timetrap, {minutes, 2}}].
+
+all() ->
+    [send_long].
+
+%% ===========================================================================
+
+%% send_long/1
+%%
+%% Test that a long message is received.
+
+send_long(_) ->
+    {Sock, SendF} = connection(),
+    B = list_to_binary(lists:duplicate(1 bsl 20, $X)),
+    ok = SendF(B),
+    B = recv(Sock, size(B), []).
+
+recv(_, 0, Acc) ->
+    list_to_binary(lists:reverse(Acc));
+recv(Sock, N, Acc) ->
+    receive
+        {tcp, Sock, Bin} ->
+            recv(Sock, N - size(Bin), [Bin | Acc]);
+        T ->
+            {T, Acc}
+    end.
+
+%% connection/0
+
+connection() ->
+    {ok, LSock} = gen_tcp:listen(0, ?GEN_OPTS),
+    {ok, PortNr} = inet:port(LSock),
+    LPid = self(),
+    {Pid, MRef} = spawn_monitor(fun() -> connect(PortNr, LPid) end),
+    {ok, Sock} = gen_tcp:accept(LSock),
+    receive
+        {Pid, F} ->
+            {Sock, F};
+        {'DOWN', MRef, process, _, _} = T ->
+            T
+    end.
+
+%% connect/2
+
+connect(PortNr, LPid) ->
+    {ok, Sock} = gen_tcp:connect(?LOOPBACK, PortNr, ?GEN_OPTS),
+    LPid ! {self(), fun(B) -> send(Sock, B) end},
+    down(LPid).
+
+%% down/1
+
+down(Pid)
+  when is_pid(Pid) ->
+    down(erlang:monitor(process, Pid));
+
+down(MRef) ->
+    receive {'DOWN', MRef, process, _, Reason} -> Reason end.
+
+%% send/2
+%%
+%% Send from a spawned process just to avoid sending from the
+%% receiving process, in case it's significant.
+
+send(Sock, Bin) ->
+    {_, MRef} = spawn_monitor(fun() -> exit(gen_tcp:send(Sock, Bin)) end),
+    down(MRef).
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 5a79c63d36..55565692ec 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -181,7 +181,7 @@ start_diameter(_Config) ->
     ok = diameter:start().
 
 make_certs() ->
-    [{timetrap, {seconds, 30}}].
+    [{timetrap, {minutes, 2}}].
 
 make_certs(Config) ->
     Dir = proplists:get_value(priv_dir, Config),
@@ -302,9 +302,7 @@ set([H|T], Vs) ->
 
 disconnect({{LRef, _PortNr}, CRef}) ->
     ok = diameter:remove_transport(?CLIENT, CRef),
-    ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
-         after 2000 -> false
-         end.
+    receive #diameter_event{info = {down, LRef, _, _}} -> ok end.
 
 realm(Host) ->
     tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
@@ -365,13 +363,11 @@ ssl([{ssl_options = T, Opts}]) ->
 
 connect(Host, {_LRef, PortNr}, {Caps, Opts}) ->
     {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)),
-    ok = receive
-             #diameter_event{service = Host,
-                             info = {up, Ref, _, _, #diameter_packet{}}} ->
-                 ok
-         after 2000 ->
-                 false
-         end,
+    receive
+        #diameter_event{service = Host,
+                        info = {up, Ref, _, _, #diameter_packet{}}} ->
+            ok
+    end,
     Ref.
 
 copts(S, Opts)
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 781ed234cc..2684ab8fe4 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -405,7 +405,7 @@ send_eval(Config) ->
 send_bad_answer(Config) ->
     Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
                   {'Accounting-Record-Number', 2}],
-    {error, timeout} = call(Config, Req).
+    {timeout, _} = call(Config, Req).
 
 %% Send an ACR that the server callback answers explicitly with a
 %% protocol error.
@@ -455,7 +455,7 @@ send_unknown_mandatory(Config) ->
 %% Send an STR that the server ignores.
 send_noreply(Config) ->
     Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
-    {error, timeout} = call(Config, Req).
+    {timeout, _} = call(Config, Req).
 
 %% Send an unsupported command and expect 3001.
 send_unsupported(Config) ->
@@ -552,7 +552,7 @@ send_all_2(Config) ->
 %% 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}]).
+    {timeout, _} = call(Config, Req, [{timeout, 1000}]).
 
 %% Explicitly answer with an answer-message and ensure that we
 %% received the Session-Id.
@@ -560,7 +560,7 @@ send_error(Config) ->
     Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
     ?answer_message(SId, ?TOO_BUSY)
         = call(Config, Req),
-    undefined /= SId.
+    true = undefined /= SId.
 
 %% Send a request with the detached option and receive it as a message
 %% from handle_answer instead.
@@ -568,7 +568,7 @@ send_detach(Config) ->
     Req = ['STR', {'Termination-Cause', ?LOGOUT}],
     Ref = make_ref(),
     ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
-    Ans = receive {Ref, T} -> T after 2000 -> false end,
+    Ans = receive {Ref, T} -> T end,
     ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _]
         = Ans.
 
@@ -683,7 +683,7 @@ call(Config, Req, Opts) ->
     diameter:call(?CLIENT,
                   dict(Req, Dict0),
                   msg(Req, ReqEncoding, Dict0),
-                  [{extra, [Name, Group]} | Opts]).
+                  [{extra, [{Name, Group}, now()]} | Opts]).
 
 origin({A,C}) ->
     2*codec(A) + container(C);
@@ -767,14 +767,14 @@ peer_down(_SvcName, _Peer, State) ->
 
 %% pick_peer/6-7
 
-pick_peer(Peers, _, ?CLIENT, _State, Name, Group)
+pick_peer(Peers, _, ?CLIENT, _State, {Name, Group}, _)
   when Name /= send_detach ->
     find(Group, Peers).
 
-pick_peer(_Peers, _, ?CLIENT, _State, send_nopeer, _, ?EXTRA) ->
+pick_peer(_Peers, _, ?CLIENT, _State, {send_nopeer, _}, _, ?EXTRA) ->
     false;
 
-pick_peer(Peers, _, ?CLIENT, _State, send_detach, Group, {_,_}) ->
+pick_peer(Peers, _, ?CLIENT, _State, {send_detach, Group}, _, {_,_}) ->
     find(Group, Peers).
 
 find(#group{server_encoding = A, server_container = C}, Peers) ->
@@ -789,13 +789,13 @@ id(Id, {Pid, _Caps}) ->
 
 %% prepare_request/5-6
 
-prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard, _) ->
+prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, {send_discard, _}, _) ->
     {discard, unprepared};
 
-prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) ->
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {Name, Group}, _) ->
     {send, prepare(Pkt, Caps, Name, Group)}.
 
-prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) ->
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {send_detach, Group}, _, _) ->
     {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}.
 
 log(#diameter_packet{bin = Bin} = P, T)
@@ -928,10 +928,10 @@ prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) ->
 
 %% handle_answer/6-7
 
-handle_answer(Pkt, Req, ?CLIENT, Peer, Name, Group) ->
+handle_answer(Pkt, Req, ?CLIENT, Peer, {Name, Group}, _) ->
     answer(Pkt, Req, Peer, Name, Group).
 
-handle_answer(Pkt, Req, ?CLIENT, Peer, send_detach = Name, Group, X) ->
+handle_answer(Pkt, Req, ?CLIENT, Peer, {send_detach = Name, Group}, _, X) ->
     {Pid, Ref} = X,
     Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}.
 
@@ -959,7 +959,11 @@ app(Req, _, Dict0) ->
 
 %% handle_error/6
 
-handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Group) ->
+handle_error(timeout = Reason, _Req, ?CLIENT, _Peer, _, Time) ->
+    Now = now(),
+    {Reason, {Time, Now, timer:now_diff(Now, Time)}};
+
+handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) ->
     {error, Reason}.
 
 %% handle_request/3
@@ -1085,7 +1089,6 @@ request(#diameter_base_STR{'Session-Id' = SId},
                     {'Origin-Host', OH},
                     {'Origin-Realm', OR}]};
 
-%% send_error
+%% send_error/send_timeout
 request(#diameter_base_RAR{}, _Caps) ->
-    receive after 2000 -> ok end,
-    {protocol_error, ?TOO_BUSY}.
+    receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 1a829f8031..4fea62461c 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -38,6 +38,7 @@ MODULES = \
 	diameter_examples_SUITE \
 	diameter_failover_SUITE \
 	diameter_gen_sctp_SUITE \
+	diameter_gen_tcp_SUITE \
 	diameter_length_SUITE \
 	diameter_reg_SUITE \
 	diameter_relay_SUITE \