← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/stdlib/test/gen_server_SUITE.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/stdlib/test/gen_server_SUITE.erl
1
1
%%
2
2
%% %CopyrightBegin%
3
 
%% 
4
 
%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
5
 
%% 
 
3
%%
 
4
%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
 
5
%%
6
6
%% The contents of this file are subject to the Erlang Public License,
7
7
%% Version 1.1, (the "License"); you may not use this file except in
8
8
%% compliance with the License. You should have received a copy of the
9
9
%% Erlang Public License along with this software. If not, it can be
10
10
%% retrieved online at http://www.erlang.org/.
11
 
%% 
 
11
%%
12
12
%% Software distributed under the License is distributed on an "AS IS"
13
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
14
14
%% the License for the specific language governing rights and limitations
15
15
%% under the License.
16
 
%% 
 
16
%%
17
17
%% %CopyrightEnd%
18
18
%%
19
19
-module(gen_server_SUITE).
20
20
 
21
 
-include("test_server.hrl").
 
21
-include_lib("test_server/include/test_server.hrl").
22
22
-include_lib("kernel/include/inet.hrl").
23
23
 
24
 
-export([init_per_testcase/2, fin_per_testcase/2]).
 
24
-export([init_per_testcase/2, end_per_testcase/2]).
25
25
 
26
 
-export([all/1]).
 
26
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 
27
         init_per_group/2,end_per_group/2]).
27
28
-export([start/1, crash/1, call/1, cast/1, cast_fast/1,
28
29
         info/1, abcast/1, multicall/1, multicall_down/1,
29
30
         call_remote1/1, call_remote2/1, call_remote3/1,
30
31
         call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1,
31
32
         spec_init_local_registered_parent/1, 
32
33
         spec_init_global_registered_parent/1,
33
 
         otp_5854/1, hibernate/1, otp_7669/1
 
34
         otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1,
 
35
         error_format_status/1, call_with_huge_message_queue/1
34
36
        ]).
35
37
 
36
38
% spawn export
42
44
 
43
45
% The gen_server behaviour
44
46
-export([init/1, handle_call/3, handle_cast/2,
45
 
         handle_info/2, terminate/2]).
46
 
 
47
 
all(suite) ->
48
 
    [start, crash, call, cast, cast_fast, info,
49
 
     abcast, multicall, multicall_down, call_remote1,
50
 
     call_remote2, call_remote3, call_remote_n1,
51
 
     call_remote_n2, call_remote_n3, spec_init,
 
47
         handle_info/2, terminate/2, format_status/2]).
 
48
 
 
49
suite() -> [{ct_hooks,[ts_install_cth]}].
 
50
 
 
51
all() -> 
 
52
    [start, crash, call, cast, cast_fast, info, abcast,
 
53
     multicall, multicall_down, call_remote1, call_remote2,
 
54
     call_remote3, call_remote_n1, call_remote_n2,
 
55
     call_remote_n3, spec_init,
52
56
     spec_init_local_registered_parent,
53
 
     spec_init_global_registered_parent,
54
 
     otp_5854,hibernate,otp_7669].
 
57
     spec_init_global_registered_parent, otp_5854, hibernate,
 
58
     otp_7669, call_format_status, error_format_status,
 
59
     call_with_huge_message_queue].
 
60
 
 
61
groups() -> 
 
62
    [].
 
63
 
 
64
init_per_suite(Config) ->
 
65
    Config.
 
66
 
 
67
end_per_suite(_Config) ->
 
68
    ok.
 
69
 
 
70
init_per_group(_GroupName, Config) ->
 
71
    Config.
 
72
 
 
73
end_per_group(_GroupName, Config) ->
 
74
    Config.
 
75
 
55
76
 
56
77
-define(default_timeout, ?t:minutes(1)).
57
78
 
 
79
init_per_testcase(Case, Config) when Case == call_remote1;
 
80
                                     Case == call_remote2;
 
81
                                     Case == call_remote3;
 
82
                                     Case == call_remote_n1;
 
83
                                     Case == call_remote_n2;
 
84
                                     Case == call_remote_n3 ->
 
85
    {ok,N} = start_node(hubba),
 
86
    ?line Dog = ?t:timetrap(?default_timeout),
 
87
    [{node,N},{watchdog, Dog} | Config];
58
88
init_per_testcase(_Case, Config) ->
59
89
    ?line Dog = ?t:timetrap(?default_timeout),
60
90
    [{watchdog, Dog} | Config].
61
 
fin_per_testcase(_Case, Config) ->
 
91
end_per_testcase(_Case, Config) ->
 
92
    case proplists:get_value(node, Config) of
 
93
        undefined ->
 
94
            ok;
 
95
        N ->
 
96
            test_server:stop_node(N)
 
97
    end,
62
98
    Dog = ?config(watchdog, Config),
63
99
    test_server:timetrap_cancel(Dog),
64
100
    ok.
291
327
 
292
328
call_remote1(suite) -> [];
293
329
call_remote1(Config) when is_list(Config) ->
294
 
    ?line N = hubba,
295
 
    ?line {ok, Node} = start_node(N),
 
330
    N = hubba,
 
331
    ?line Node = proplists:get_value(node,Config),
296
332
    ?line {ok, Pid} = rpc:call(Node, gen_server, start,
297
333
                               [{global, N}, ?MODULE, [], []]),    
298
334
    ?line ok = (catch gen_server:call({global, N}, started_p, infinity)),
305
341
call_remote2(suite) -> [];
306
342
call_remote2(Config) when is_list(Config) ->
307
343
    ?line N = hubba,
308
 
    ?line {ok, Node} = start_node(N),
 
344
    ?line Node = proplists:get_value(node,Config),
309
345
 
310
346
    ?line {ok, Pid} = rpc:call(Node, gen_server, start,
311
347
                               [{global, N}, ?MODULE, [], []]),
318
354
 
319
355
call_remote3(suite) -> [];
320
356
call_remote3(Config) when is_list(Config) ->
321
 
    ?line N = hubba,
322
 
    ?line {ok, Node} = start_node(N),
 
357
    ?line Node = proplists:get_value(node,Config),
323
358
 
324
359
    ?line {ok, Pid} = rpc:call(Node, gen_server, start,
325
360
                               [{local, piller}, ?MODULE, [], []]),
337
372
call_remote_n1(suite) -> [];
338
373
call_remote_n1(Config) when is_list(Config) ->
339
374
    ?line N = hubba,
340
 
    ?line {ok, Node} = start_node(N),
 
375
    ?line Node = proplists:get_value(node,Config),    
341
376
    ?line {ok, _Pid} = rpc:call(Node, gen_server, start,
342
377
                               [{global, N}, ?MODULE, [], []]),
343
378
    ?line _ = test_server:stop_node(Node),
349
384
call_remote_n2(suite) -> [];
350
385
call_remote_n2(Config) when is_list(Config) ->
351
386
    ?line N = hubba,
352
 
    ?line {ok, Node} = start_node(N),
 
387
    ?line Node = proplists:get_value(node,Config),
353
388
 
354
389
    ?line {ok, Pid} = rpc:call(Node, gen_server, start,
355
390
                               [{global, N}, ?MODULE, [], []]),
361
396
 
362
397
call_remote_n3(suite) -> [];
363
398
call_remote_n3(Config) when is_list(Config) ->
364
 
    ?line N = hubba,
365
 
    ?line {ok, Node} = start_node(N),
 
399
    ?line Node = proplists:get_value(node,Config),
366
400
 
367
401
    ?line {ok, _Pid} = rpc:call(Node, gen_server, start,
368
402
                               [{local, piller}, ?MODULE, [], []]),
851
885
    ok.
852
886
 
853
887
%% If initialization fails (with ignore or {stop,Reason}),
854
 
%% make sure that the process is not registered when gen_sever:start()
 
888
%% make sure that the process is not registered when gen_server:start()
855
889
%% returns.
856
890
 
857
891
otp_7669(Config) when is_list(Config) ->
887
921
                                             ?MODULE, stop, []),
888
922
    ?line undefined = global:whereis_name(?MODULE).
889
923
 
 
924
%% Verify that sys:get_status correctly calls our format_status/2 fun
 
925
%%
 
926
call_format_status(suite) ->
 
927
    [];
 
928
call_format_status(doc) ->
 
929
    ["Test that sys:get_status/1,2 calls format_status/2"];
 
930
call_format_status(Config) when is_list(Config) ->
 
931
    ?line {ok, Pid} = gen_server:start_link({local, call_format_status},
 
932
                                            ?MODULE, [], []),
 
933
    ?line Status1 = sys:get_status(call_format_status),
 
934
    ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data1]} = Status1,
 
935
    ?line [format_status_called | _] = lists:reverse(Data1),
 
936
    ?line Status2 = sys:get_status(call_format_status, 5000),
 
937
    ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data2]} = Status2,
 
938
    ?line [format_status_called | _] = lists:reverse(Data2),
 
939
 
 
940
    %% check that format_status can handle a name being a pid (atom is
 
941
    %% already checked by the previous test)
 
942
    ?line {ok, Pid3} = gen_server:start_link(gen_server_SUITE, [], []),
 
943
    ?line Status3 = sys:get_status(Pid3),
 
944
    ?line {status, Pid3, _Mod, [_PDict3, running, _Parent, _, Data3]} = Status3,
 
945
    ?line [format_status_called | _] = lists:reverse(Data3),
 
946
 
 
947
    %% check that format_status can handle a name being a term other than a
 
948
    %% pid or atom
 
949
    GlobalName1 = {global, "CallFormatStatus"},
 
950
    ?line {ok, Pid4} = gen_server:start_link(GlobalName1,
 
951
                                             gen_server_SUITE, [], []),
 
952
    ?line Status4 = sys:get_status(Pid4),
 
953
    ?line {status, Pid4, _Mod, [_PDict4, running, _Parent, _, Data4]} = Status4,
 
954
    ?line [format_status_called | _] = lists:reverse(Data4),
 
955
    GlobalName2 = {global, {name, "term"}},
 
956
    ?line {ok, Pid5} = gen_server:start_link(GlobalName2,
 
957
                                             gen_server_SUITE, [], []),
 
958
    ?line Status5 = sys:get_status(GlobalName2),
 
959
    ?line {status, Pid5, _Mod, [_PDict5, running, _Parent, _, Data5]} = Status5,
 
960
    ?line [format_status_called | _] = lists:reverse(Data5),
 
961
    ok.
 
962
 
 
963
%% Verify that error termination correctly calls our format_status/2 fun
 
964
%%
 
965
error_format_status(suite) ->
 
966
    [];
 
967
error_format_status(doc) ->
 
968
    ["Test that an error termination calls format_status/2"];
 
969
error_format_status(Config) when is_list(Config) ->
 
970
    ?line error_logger_forwarder:register(),
 
971
    OldFl = process_flag(trap_exit, true),
 
972
    State = "called format_status",
 
973
    ?line {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []),
 
974
    ?line {'EXIT',{crashed,_}} = (catch gen_server:call(Pid, crash)),
 
975
    receive
 
976
        {'EXIT', Pid, crashed} ->
 
977
            ok
 
978
    end,
 
979
    receive
 
980
        {error,_GroupLeader,{Pid,
 
981
                             "** Generic server"++_,
 
982
                             [Pid,crash,State,crashed]}} ->
 
983
            ok;
 
984
        Other ->
 
985
            ?line io:format("Unexpected: ~p", [Other]),
 
986
            ?line ?t:fail()
 
987
    end,
 
988
    ?t:messages_get(),
 
989
    process_flag(trap_exit, OldFl),
 
990
    ok.
 
991
 
 
992
%% Test that the time for a huge message queue is not
 
993
%% significantly slower than with an empty message queue.
 
994
call_with_huge_message_queue(Config) when is_list(Config) ->
 
995
    ?line Pid = spawn_link(fun echo_loop/0),
 
996
 
 
997
    ?line {Time,ok} = tc(fun() -> calls(10, Pid) end),
 
998
 
 
999
    ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)],
 
1000
    erlang:garbage_collect(),
 
1001
    ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end),
 
1002
    io:format("Time for empty message queue: ~p", [Time]),
 
1003
    io:format("Time for huge message queue: ~p", [NewTime]),
 
1004
 
 
1005
    case (NewTime+1) / (Time+1) of
 
1006
        Q when Q < 10 ->
 
1007
            ok;
 
1008
        Q ->
 
1009
            io:format("Q = ~p", [Q]),
 
1010
            ?line ?t:fail()
 
1011
    end,
 
1012
    ok.
 
1013
 
 
1014
calls(0, _) -> ok;
 
1015
calls(N, Pid) ->
 
1016
    {ultimate_answer,42} = call(Pid, {ultimate_answer,42}),
 
1017
    calls(N-1, Pid).
 
1018
 
 
1019
call(Pid, Msg) ->
 
1020
    gen_server:call(Pid, Msg, infinity).
 
1021
 
 
1022
tc(Fun) ->
 
1023
    timer:tc(erlang, apply, [Fun,[]]).
 
1024
 
 
1025
echo_loop() ->
 
1026
    receive
 
1027
        {'$gen_call',{Pid,Ref},Msg} ->
 
1028
            Pid ! {Ref,Msg},
 
1029
            echo_loop()
 
1030
    end.
 
1031
 
890
1032
%%--------------------------------------------------------------
891
1033
%% Help functions to spec_init_*
892
1034
start_link(Init, Options) ->
1046
1188
terminate(_Reason, _State) ->
1047
1189
    ok.
1048
1190
 
1049
 
 
 
1191
format_status(terminate, [_PDict, State]) ->
 
1192
    State;
 
1193
format_status(normal, [_PDict, _State]) ->
 
1194
    format_status_called.