Add locking mechanism for scb state when using parallel groups

5 files changed, 200 insertions, 18 deletions

diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 14a0a27051..abf7816a91 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -68,7 +68,8 @@ MODULES= \
 	ct_config_plain \
 	ct_config_xml \
 	ct_slave \
-        ct_suite_callback
+        ct_suite_callback\
+        ct_suite_callback_lock
 
 TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
 
diff --git a/lib/common_test/src/ct_suite_callback.erl b/lib/common_test/src/ct_suite_callback.erl
index 4973ed685c..46bc250106 100644
--- a/lib/common_test/src/ct_suite_callback.erl
+++ b/lib/common_test/src/ct_suite_callback.erl
@@ -34,6 +34,8 @@
 -type proplist() :: [{atom(),term()}].
 
 -define(config_name, suite_callbacks).
+-define(LOCK_STATE_TIMEOUT, 500).
+-define(LOCK_NAME, '$ct_suite_callback_lock').
 
 %% -------------------------------------------------------------------------
 %% API Functions
@@ -69,7 +71,8 @@ init_tc(Mod, init_per_suite, Config) ->
     call(fun call_generic/3, Config, [pre_init_per_suite, Mod]);
 init_tc(Mod, end_per_suite, Config) ->
     call(fun call_generic/3, Config, [pre_end_per_suite, Mod]);
-init_tc(_Mod, {init_per_group, GroupName, _}, Config) ->
+init_tc(Mod, {init_per_group, GroupName, Opts}, Config) ->
+    maybe_start_locker(Mod, GroupName, Opts),
     call(fun call_generic/3, Config, [pre_init_per_group, GroupName]);
 init_tc(_Mod, {end_per_group, GroupName, _}, Config) ->
     call(fun call_generic/3, Config, [pre_end_per_group, GroupName]);
@@ -91,7 +94,7 @@ init_tc(_Mod, TC, Config) ->
 end_tc(ct_framework, _Func, _Args, Result, _Return) ->
     Result;
 
-end_tc(Mod, init_per_suite, Config, Result, Return) ->
+end_tc(Mod, init_per_suite, Config, _Result, Return) ->
     call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config],
 	 '$ct_no_change');
 
@@ -99,13 +102,15 @@ end_tc(Mod, end_per_suite, Config, Result, _Return) ->
     call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config],
 	'$ct_no_change');
 
-end_tc(_Mod, {init_per_group, GroupName, _}, Config, Result, Return) ->
+end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
     call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config],
 	 '$ct_no_change');
 
-end_tc(_Mod, {end_per_group, GroupName, _}, Config, Result, _Return) ->
-    call(fun call_generic/3, Result, [post_end_per_group, GroupName, Config],
-	'$ct_no_change');
+end_tc(Mod, {end_per_group, GroupName, Opts}, Config, Result, _Return) ->
+    Res = call(fun call_generic/3, Result,
+	       [post_end_per_group, GroupName, Config], '$ct_no_change'),
+    maybe_stop_locker(Mod, GroupName,Opts),
+    Res;
 
 end_tc(_Mod, TC, Config, Result, _Return) ->
     call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
@@ -142,9 +147,13 @@ call_generic({Mod, State}, Value, [Function | Args]) ->
 
 %% Generic call function
 call(Fun, Config, Meta) ->
+    maybe_lock(),
     CBs = get_callbacks(),
-    call([{CBId,Fun} || {CBId,_, _} <- CBs] ++ get_new_callbacks(Config, Fun),
-	     remove(?config_name,Config), Meta, CBs).
+    Res = call([{CBId,Fun} || {CBId,_, _} <- CBs] ++
+	       get_new_callbacks(Config, Fun),
+	       remove(?config_name,Config), Meta, CBs),
+    maybe_unlock(),
+    Res.
 
 call(Fun, Config, Meta, NoChangeRet) when is_function(Fun) ->
     case call(Fun,Config,Meta) of
@@ -255,3 +264,30 @@ catch_apply(M,F,A, Default) ->
 					   [M,F,length(A)]))})
 	    end
     end.
+
+
+%% We need to lock around the state for parallel groups only. This is because
+%% we will get several processes reading and writing the state for a single
+%% scb at the same time.
+maybe_start_locker(Mod,GroupName,Opts) ->
+    case lists:member(parallel,Opts) of
+	true ->
+	    {ok, _Pid} = ct_suite_callback_lock:start({Mod,GroupName});
+	false ->
+	    ok
+    end.
+
+maybe_stop_locker(Mod,GroupName,Opts) ->
+    case lists:member(parallel,Opts) of
+	true ->
+	    stopped = ct_suite_callback_lock:stop({Mod,GroupName});
+	false ->
+	    ok
+    end.
+
+
+maybe_lock() ->
+    locked = ct_suite_callback_lock:request().
+
+maybe_unlock() ->
+    unlocked = ct_suite_callback_lock:release().
diff --git a/lib/common_test/src/ct_suite_callback_lock.erl b/lib/common_test/src/ct_suite_callback_lock.erl
new file mode 100644
index 0000000000..84dafd1e42
--- /dev/null
+++ b/lib/common_test/src/ct_suite_callback_lock.erl
@@ -0,0 +1,131 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2010. 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%
+%%
+
+%%% @doc Common Test Framework test execution control module.
+%%%
+%%% <p>This module is a proxy for calling and handling locks in suite callbacks.</p>
+
+-module(ct_suite_callback_lock).
+
+-behaviour(gen_server).
+
+%% API
+-export([start/1, stop/1, request/0, release/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+	 terminate/2, code_change/3]).
+
+-define(SERVER, ?MODULE). 
+
+-record(state, { id, locked = false, requests = [] }).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+%% @doc Starts the server
+start(Id) ->
+    case gen_server:start({local, ?SERVER}, ?MODULE, Id, []) of
+	{error,{already_started, Pid}} ->
+	    {ok,Pid};
+	Else ->
+	    Else
+    end.
+
+stop(Id) ->
+    try
+	gen_server:call(?SERVER, {stop,Id})
+    catch exit:{noproc,_} ->
+	    stopped
+    end.
+    
+request() ->
+    try
+	gen_server:call(?SERVER,{request,self()},infinity)
+    catch exit:{noproc,_} ->
+	    locked
+    end.
+
+release() ->
+    try
+	gen_server:call(?SERVER,{release,self()})
+    catch exit:{noproc,_} ->
+	    unlocked
+    end.
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+%% @doc Initiates the server
+init(Id) ->
+    {ok, #state{ id = Id }}.
+
+%% @doc Handling call messages
+handle_call({stop,Id}, _From, #state{ id = Id, requests = Reqs } = State) ->
+    [gen_server:reply(Req, locker_stopped) || {Req,_ReqId} <- Reqs],
+    {stop, normal, stopped, State};
+handle_call({stop,_Id}, _From, State) ->
+    {reply, stopped, State};
+handle_call({request, Pid}, _From, #state{ locked = false,
+					  requests = [] } = State) ->
+    Ref = monitor(process, Pid),
+    {reply, locked, State#state{ locked = {true, Pid, Ref}} };
+handle_call({request, Pid}, From, #state{ requests = Reqs } = State) ->
+    {noreply, State#state{ requests = Reqs ++ [{From,Pid}] }};
+handle_call({release, Pid}, _From, #state{ locked = {true, Pid, Ref},
+					  requests = []} = State) ->
+    demonitor(Ref,[flush]),
+    {reply, unlocked, State#state{ locked = false }};
+handle_call({release, Pid}, _From,
+	    #state{ locked = {true, Pid, Ref},
+		    requests = [{NextFrom,NextPid}|Rest]} = State) ->
+    demonitor(Ref,[flush]),
+    gen_server:reply(NextFrom,locked),
+    NextRef = monitor(process, NextPid),
+    {reply,unlocked,State#state{ locked = {true, NextPid, NextRef},
+				 requests = Rest } };
+handle_call({release, _Pid}, _From, State) ->
+    {reply, not_locked, State}.
+    
+%% @doc Handling cast messages
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+%% @doc Handling all non call/cast messages
+handle_info({'DOWN',Ref,process,Pid,_},
+	    #state{ locked = {true, Pid, Ref},
+		    requests = [{NextFrom,NextPid}|Rest] } = State) ->
+    gen_server:reply(NextFrom, locked),
+    NextRef = monitor(process, NextPid),
+    {noreply,State#state{ locked = {true, NextPid, NextRef},
+			  requests = Rest } }.
+
+%% @doc This function is called by a gen_server when it is about to terminate. 
+terminate(_Reason, _State) ->
+    ok.
+
+%% @doc Convert process state when code is changed
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%% -------------------------------------------------------------------------
+%% Internal Functions
+%% -------------------------------------------------------------------------
diff --git a/lib/common_test/test/ct_suite_callback_SUITE.erl b/lib/common_test/test/ct_suite_callback_SUITE.erl
index d60d24e237..e6e4d5706b 100644
--- a/lib/common_test/test/ct_suite_callback_SUITE.erl
+++ b/lib/common_test/test/ct_suite_callback_SUITE.erl
@@ -682,20 +682,24 @@ test_events(state_update_scb) ->
      {?eh,scb,{'_',terminate,[contains(
 				[post_end_per_suite,pre_end_per_suite,
 				 post_end_per_group,pre_end_per_group,
-				 post_end_per_testcase,pre_init_per_testcase,
-				 on_tc_skip,post_end_per_testcase,
-				 pre_init_per_testcase,on_tc_fail,
-				 post_end_per_testcase,pre_init_per_testcase,
+				 {not_in_order,
+				  [post_end_per_testcase,pre_init_per_testcase,
+				   on_tc_skip,post_end_per_testcase,
+				   pre_init_per_testcase,on_tc_fail,
+				   post_end_per_testcase,pre_init_per_testcase]
+				 },
 				 post_init_per_group,pre_init_per_group,
 				 post_init_per_suite,pre_init_per_suite,
 				 init])]}},
      {?eh,scb,{'_',terminate,[contains(
 				[post_end_per_suite,pre_end_per_suite,
 				 post_end_per_group,pre_end_per_group,
-				 post_end_per_testcase,pre_init_per_testcase,
-				 on_tc_skip,post_end_per_testcase,
-				 pre_init_per_testcase,on_tc_fail,
-				 post_end_per_testcase,pre_init_per_testcase,
+				 {not_in_order,
+				  [post_end_per_testcase,pre_init_per_testcase,
+				   on_tc_skip,post_end_per_testcase,
+				   pre_init_per_testcase,on_tc_fail,
+				   post_end_per_testcase,pre_init_per_testcase]
+				 },
 				 post_init_per_group,pre_init_per_group,
 				 post_init_per_suite,pre_init_per_suite,
 				 init]
@@ -712,6 +716,10 @@ contains(List) ->
     fun(Proplist) when is_list(Proplist) ->
 	    contains(List,Proplist)
     end.
+
+contains([{not_in_order,List}|T],Rest) ->
+    contains_parallel(List,Rest),
+    contains(T,Rest);
 contains([{Ele,Pos}|T] = L,[H|T2]) ->
     case element(Pos,H) of
 	Ele ->
@@ -728,6 +736,12 @@ contains(List,[_|T]) ->
 contains([],_) ->
     match.
 
+contains_parallel([Key | T], Elems) ->
+    contains([Key],Elems),
+    contains_parallel(T,Elems);
+contains_parallel([],Elems) ->
+    match.
+
 not_contains(List) ->
     fun(Proplist) when is_list(Proplist) ->
 	    [] = [Ele || {Ele,_} <- Proplist,
diff --git a/lib/common_test/test/ct_suite_callback_SUITE_data/scb/tests/ct_scb_fail_one_skip_one_SUITE.erl b/lib/common_test/test/ct_suite_callback_SUITE_data/scb/tests/ct_scb_fail_one_skip_one_SUITE.erl
index dfeacfe8b1..593bd4a534 100644
--- a/lib/common_test/test/ct_suite_callback_SUITE_data/scb/tests/ct_scb_fail_one_skip_one_SUITE.erl
+++ b/lib/common_test/test/ct_suite_callback_SUITE_data/scb/tests/ct_scb_fail_one_skip_one_SUITE.erl
@@ -48,7 +48,7 @@ end_per_testcase(_TestCase, _Config) ->
     ok.

 

 groups() ->

-    [{group1,[],[test_case1,test_case2,test_case3]}].

+    [{group1,[parallel],[{group2,[parallel],[test_case1,test_case2,test_case3]}]}].

 

 all() ->

     [{group,group1}].