Introduce ct_group_leader_SUITE that does nasty things with group leaders

3 files changed, 400 insertions, 1 deletions

diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index 7691920993..64e2cb6507 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -53,7 +53,8 @@ MODULES= \
 	ct_verbosity_SUITE \
 	ct_shell_SUITE \
 	ct_system_error_SUITE \
-	ct_snmp_SUITE
+	ct_snmp_SUITE \
+	ct_group_leader_SUITE
 
 ERL_FILES= $(MODULES:%=%.erl)
 
diff --git a/lib/common_test/test/ct_group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE.erl
new file mode 100644
index 0000000000..5f40eba826
--- /dev/null
+++ b/lib/common_test/test/ct_group_leader_SUITE.erl
@@ -0,0 +1,175 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. 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%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File: ct_system_error_SUITE
+%%%
+%%% Description:
+%%%
+%%% Test the group leader functionality in the test_server application.
+%%%-------------------------------------------------------------------
+-module(ct_group_leader_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+-define(eh, ct_test_support_eh).
+
+%%--------------------------------------------------------------------
+%% TEST SERVER CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+%%--------------------------------------------------------------------
+%% Description: Since Common Test starts another Test Server
+%% instance, the tests need to be performed on a separate node (or
+%% there will be clashes with logging processes etc).
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+    Config1 = ct_test_support:init_per_suite(Config),
+    Config1.
+
+end_per_suite(Config) ->
+    ct_test_support:end_per_suite(Config).
+
+init_per_testcase(TestCase, Config) ->
+    ct_test_support:init_per_testcase(TestCase, Config).
+
+end_per_testcase(TestCase, Config) ->
+    ct_test_support:end_per_testcase(TestCase, Config).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+    [
+     basic
+    ].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+
+%%%-----------------------------------------------------------------
+%%%
+basic(Config) ->
+    TC = basic,
+    DataDir = ?config(data_dir, Config),
+    Suite = filename:join(DataDir, "group_leader_SUITE"),
+    {Opts,ERPid} = setup([{suite,Suite},{label,TC}], Config),
+    SuiteLog = execute(TC, Opts, ERPid, Config),
+    {ok,Data} = file:read_file(SuiteLog),
+    Lines = binary:split(Data, <<"\n">>, [global]),
+    {ok,RE} = re:compile("(\\S+):(\\S+)$"),
+    Cases0 = [begin
+		  {match,[M,F]} = re:run(Case, RE, [{capture,all_but_first,list}]),
+		  {list_to_atom(M),list_to_atom(F)}
+	      end || <<"=case ",Case/binary>> <- Lines],
+    Cases = [MF || {_,F}=MF <- Cases0,
+		   F =/= init_per_suite,
+		   F =/= end_per_suite,
+		   F =/= init_per_group,
+		   F =/= end_per_group],
+    io:format("~p\n", [Cases]),
+    [] = verify_cases(events_to_check(TC), Cases, false),
+    ok.
+
+verify_cases([{parallel,P}|Ts], Cases0, Par) ->
+    Cases = verify_cases(P, Cases0, true),
+    verify_cases(Ts, Cases, Par);
+verify_cases([{?eh,tc_done,{M,F,_}}|Ts], Cases0, false) ->
+    [{M,F}|Cases] = Cases0,
+    verify_cases(Ts, Cases, false);
+verify_cases([{?eh,tc_done,{M,F,_}}|Ts], Cases0, true) ->
+    case lists:member({M,F}, Cases0) of
+	true ->
+	    Cases = Cases0 -- [{M,F}],
+	    verify_cases(Ts, Cases, true);
+	false ->
+	    io:format("~p not found\n", [{M,F}]),
+	    ?t:fail()
+    end;
+verify_cases([{?eh,_,_}|Ts], Cases, Par) ->
+    verify_cases(Ts, Cases, Par);
+verify_cases([], Cases, _) ->
+    Cases;
+verify_cases([List|Ts], Cases0, Par) when is_list(List) ->
+    Cases = verify_cases(List, Cases0, false),
+    verify_cases(Ts, Cases, Par).
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+
+setup(Test, Config) ->
+    Opts0 = ct_test_support:get_opts(Config),
+    Level = ?config(trace_level, Config),
+    EvHArgs = [{cbm,ct_test_support},{trace_level,Level}],
+    Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test],
+    ERPid = ct_test_support:start_event_receiver(Config),
+    {Opts,ERPid}.
+
+execute(Name, Opts, ERPid, Config) ->
+    ok = ct_test_support:run(Opts, Config),
+    Events = ct_test_support:get_events(ERPid, Config),
+
+    ct_test_support:log_events(Name,
+			       reformat(Events, ?eh),
+			       ?config(priv_dir, Config),
+			       Opts),
+
+    TestEvents = events_to_check(Name),
+    ok = ct_test_support:verify_events(TestEvents, Events, Config),
+    {event,tc_logfile,_,{_,File}} =
+	lists:keyfind(tc_logfile, 2, [Ev || {?eh,Ev} <- Events]),
+    LogDir = filename:dirname(File),
+    filename:join(LogDir, "suite.log").
+
+reformat(Events, EH) ->
+    ct_test_support:reformat(Events, EH).
+
+%%%-----------------------------------------------------------------
+%%% TEST EVENTS
+%%%-----------------------------------------------------------------
+
+events_to_check(_Test) ->
+    [{?eh,tc_done,{group_leader_SUITE,tc1,ok}},
+     {parallel,[{?eh,tc_start,{group_leader_SUITE,p1}},
+		{?eh,tc_done,{group_leader_SUITE,p1,ok}},
+		{?eh,tc_start,{group_leader_SUITE,p2}},
+		{?eh,tc_done,{group_leader_SUITE,p2,ok}}]},
+     {?eh,tc_done,{group_leader_SUITE,p_restart_my_io_server,ok}},
+     {?eh,tc_done,{group_leader_SUITE,p3,ok}},
+     {parallel,[
+		{?eh,tc_start,{group_leader_SUITE,p10}},
+		{?eh,tc_start,{group_leader_SUITE,p11}},
+		{?eh,tc_done,{group_leader_SUITE,p10,ok}},
+		{?eh,tc_done,{group_leader_SUITE,p11,ok}},
+		[{?eh,tc_done,{group_leader_SUITE,s1,ok}},
+		 {?eh,tc_done,{group_leader_SUITE,s2,ok}},
+		 {?eh,tc_done,{group_leader_SUITE,s3,ok}}],
+		{?eh,tc_start,{group_leader_SUITE,p12}},
+		{?eh,tc_done,{group_leader_SUITE,p12,ok}},
+		[{?eh,tc_done,{group_leader_SUITE,s4,ok}},
+		 {?eh,tc_done,{group_leader_SUITE,s5,ok}}],
+		{?eh,tc_start,{group_leader_SUITE,p13}},
+		{?eh,tc_done,{group_leader_SUITE,p13,ok}} ]},
+     {?eh,test_done,{'DEF','STOP_TIME'}},
+     {?eh,stop_logging,[]}
+    ].
diff --git a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl
new file mode 100644
index 0000000000..c405a82882
--- /dev/null
+++ b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl
@@ -0,0 +1,223 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. 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(group_leader_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+%%--------------------------------------------------------------------
+%% @spec suite() -> Info
+%% Info = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+suite() ->
+    [{timetrap,{seconds,10}}].
+
+%%--------------------------------------------------------------------
+%% @spec init_per_suite(Config0) ->
+%%     Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+    start_my_io_server(),
+    Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_suite(Config0) -> void() | {save_config,Config1}
+%% Config0 = Config1 = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+end_per_suite(_Config) ->
+    my_io_server ! die,
+    ok.
+
+%%--------------------------------------------------------------------
+%% @spec init_per_group(GroupName, Config0) ->
+%%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% GroupName = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_group(_GroupName, Config) ->
+    Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_group(GroupName, Config0) ->
+%%               void() | {save_config,Config1}
+%% GroupName = atom()
+%% Config0 = Config1 = [tuple()]
+%% @end
+%%--------------------------------------------------------------------
+end_per_group(_GroupName, _Config) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% @spec init_per_testcase(TestCase, Config0) ->
+%%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+%% TestCase = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+init_per_testcase(_TestCase, Config) ->
+    Config.
+
+%%--------------------------------------------------------------------
+%% @spec end_per_testcase(TestCase, Config0) ->
+%%               void() | {save_config,Config1} | {fail,Reason}
+%% TestCase = atom()
+%% Config0 = Config1 = [tuple()]
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+end_per_testcase(_TestCase, _Config) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% @spec groups() -> [Group]
+%% Group = {GroupName,Properties,GroupsAndTestCases}
+%% GroupName = atom()
+%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]
+%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]
+%% TestCase = atom()
+%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}
+%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |
+%%              repeat_until_any_ok | repeat_until_any_fail
+%% N = integer() | forever
+%% @end
+%%--------------------------------------------------------------------
+groups() ->
+    [{p,[parallel],[p1,p2]},
+     {p_restart,[parallel],[p_restart_my_io_server]},
+     {seq,[],[s1,s2,s3]},
+     {seq2,[],[s4,s5]},
+     {seq_in_par,[parallel],[p10,p11,{group,seq},p12,{group,seq2},p13]}].
+
+%%--------------------------------------------------------------------
+%% @spec all() -> GroupsAndTestCases | {skip,Reason}
+%% GroupsAndTestCases = [{group,GroupName} | TestCase]
+%% GroupName = atom()
+%% TestCase = atom()
+%% Reason = term()
+%% @end
+%%--------------------------------------------------------------------
+all() ->
+    [tc1,{group,p},{group,p_restart},p3,
+     {group,seq_in_par}].
+
+tc1(_C) ->
+    ok.
+
+p1(_) ->
+    %% OTP-10101:
+    %%
+    %% External apps/processes started by init_per_suite (common operation),
+    %% will inherit the group leader of the init_per_suite process, i.e. the
+    %% test_server test case control process (executing run_test_case_msgloop/7).
+    %% If, later, a parallel test case triggers the external app to print with
+    %% e.g. io:format() (also common operation), the calling process will hang!
+    %% The reason for this is that a parallel test case has a dedicated IO
+    %% server process, other than the central test case control process. The
+    %% latter process is not executing run_test_case_msgloop/7 and will not
+    %% respond to IO messages. The process is still group leader for the
+    %% external app, however, which is wrong. It's the IO process for the
+    %% parallel test case that should be group leader - but only for the
+    %% particular invokation, since other parallel test cases could be
+    %% invoking the external app too.
+    print("hej\n").
+
+p2(_) ->
+    print("hopp\n").
+
+p_restart_my_io_server(_) ->
+    %% Restart the IO server and change its group leader. This used
+    %% to set to the group leader to a process that would soon die.
+    Ref = erlang:monitor(process, my_io_server),
+    my_io_server ! die,
+    receive
+	{'DOWN',Ref,_,_,_} ->
+	    start_my_io_server()
+    end.
+
+p3(_) ->
+    %% OTP-10125. This would crash since the group leader process
+    %% for the my_io_server had died.
+    print("hoppsan\n").
+
+print(String) ->
+    my_io_server ! {print,self(),String},
+    receive
+	{printed,String} ->
+	    ok
+    end.
+
+start_my_io_server() ->
+    Parent = self(),
+    Pid = spawn(fun() -> my_io_server(Parent) end),
+    receive
+	{Pid,started} ->
+	    io:format("~p\n", [process_info(Pid)]),
+	    ok
+    end.
+
+my_io_server(Parent) ->
+    register(my_io_server, self()),
+    Parent ! {self(),started},
+    my_io_server_loop().
+
+my_io_server_loop() ->
+    receive
+	{print,From,String} ->
+	    io:put_chars(String),
+	    From ! {printed,String},
+	    my_io_server_loop();
+	die ->
+	    ok
+    end.
+
+p10(_) ->
+    receive after 1 -> ok end.
+
+p11(_) ->
+    ok.
+
+p12(_) ->
+    ok.
+
+p13(_) ->
+    ok.
+
+s1(_) ->
+    ok.
+
+s2(_) ->
+    ok.
+
+s3(_) ->
+    ok.
+
+s4(_) ->
+    ok.
+
+s5(_) ->
+    ok.