From 6552e962fee833e88e27bd0773120a48c09966e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lukas=20Backstr=C3=B6m?= Date: Tue, 11 Feb 2025 13:33:41 +0100 Subject: [PATCH] ct: Fix cth_surefire to work for nested skipped groups If a group was skipped because a group above it was skipped then cth_surefire would crash when running. This commit fixes that and adds tests to make sure it works. --- lib/common_test/src/cth_surefire.erl | 42 ++++++++++++------- lib/common_test/test/ct_surefire_SUITE.erl | 19 +++++---- .../skip_init_per_group_SUITE.erl | 3 +- 3 files changed, 42 insertions(+), 22 deletions(-) diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index c09744efbd2c..023d0750ddf5 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -196,7 +196,14 @@ pre_init_per_group(_Suite,Group,Config,State) -> post_init_per_group(Suite,Group,Config,Result,Proxy) when is_pid(Proxy) -> {gen_server:call(Proxy,{?FUNCTION_NAME, [Suite, Group, Config, Result]}),Proxy}; post_init_per_group(_Suite,_Group,Config,Result,State) -> - {Result, end_tc(init_per_group,Config,Result,State)}. + NewState = end_tc(init_per_group,Config,Result,State), + case Result of + {skip, _} -> + %% on_tc_skip will be called which will re-add this group + {Result, NewState#state{ curr_group = tl(NewState#state.curr_group) }}; + _ -> + {Result, NewState} + end. pre_end_per_group(Suite,Group,Config,Proxy) when is_pid(Proxy) -> {gen_server:call(Proxy,{?FUNCTION_NAME, [Suite, Group, Config]}),Proxy}; @@ -253,26 +260,30 @@ get_line_from_result(_, _) -> on_tc_skip(Suite,TC,Result,Proxy) when is_pid(Proxy) -> _ = gen_server:call(Proxy,{?FUNCTION_NAME, [Suite,TC,Result]}), Proxy; -on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) -> - on_tc_skip(Suite,ConfigFunc, Res, State); +on_tc_skip(Suite,{init_per_group,GrName}, Res, State) -> + on_tc_skip(Suite,init_per_group, Res, State#state{ curr_group = [GrName | State#state.curr_group]}); +on_tc_skip(Suite,{end_per_group,_GrName}, Res, State) -> + NewState = on_tc_skip(Suite,end_per_group, Res, State), + NewState#state{ curr_group = tl(State#state.curr_group)}; +on_tc_skip(Suite,{ConfigFunc,GrName}, Res, State) -> + if GrName =:= hd(State#state.curr_group) -> + on_tc_skip(Suite,ConfigFunc, Res, State); + true -> + NewState = on_tc_skip(Suite,ConfigFunc, Res, + State#state{ curr_group = [GrName | State#state.curr_group]}), + NewState#state{ curr_group = tl(NewState#state.curr_group)} + end; on_tc_skip(Suite,Tc, Res, State0) -> TcStr = atom_to_list(Tc), + CurrGroup = make_group_string(State0#state.curr_group), State1 = case State0#state.test_cases of - [#testcase{name=TcStr}|TCs] -> + [#testcase{name=TcStr,group=CurrGroup}|TCs] -> State0#state{test_cases=TCs}; _ -> State0 end, - State2 = end_tc(Tc,[],Res,init_tc(set_suite(Suite,State1),[])), - CurrGroup = State2#state.curr_group, - State = - case {Tc, is_list(CurrGroup) andalso length(CurrGroup)>0}of - {end_per_group, true} -> - State2#state{curr_group = tl(CurrGroup)}; - _ -> - State2 - end, + State = end_tc(Tc,[],Res,init_tc(set_suite(Suite,State1),[])), do_tc_skip(Res, State). do_tc_skip(Res, State) -> @@ -313,7 +324,7 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, end, Url = make_url(UrlBase,Log), ClassName = atom_to_list(Suite), - PGroup = lists:concat(lists:join(".",lists:reverse(Groups))), + PGroup = make_group_string(Groups), TimeTakes = io_lib:format("~f",[timer:now_diff(?now,TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, url = Url, @@ -329,6 +340,9 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, State#state.test_cases], tc_log = ""}. % so old tc_log is not set if next is on_tc_skip +make_group_string(Groups) -> + lists:concat(lists:join(".",lists:reverse(Groups))). + set_suite(Suite,#state{curr_suite=undefined}=State) -> State#state{curr_suite=Suite, curr_suite_ts=?now}; set_suite(_,State) -> diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index 75a42011d962..f6a5e76396f1 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -252,6 +252,9 @@ test_suite_events(skip_init_per_group_SUITE) -> {?eh,tc_user_skip, {skip_init_per_group_SUITE,{test_case,left},skip_on_purpose}}, {?eh,test_stats,{0,0,{1,0}}}, + {?eh,tc_user_skip, + {skip_init_per_group_SUITE,{test_case,nested_group},skip_on_purpose}}, + {?eh,test_stats,{0,0,{2,0}}}, {?eh,tc_user_skip, {skip_init_per_group_SUITE,{end_per_group,left},skip_on_purpose}}], @@ -261,7 +264,7 @@ test_suite_events(skip_init_per_group_SUITE) -> {skip_init_per_group_SUITE,{init_per_group,right,[]},ok}}, {?eh,tc_start,{skip_init_per_group_SUITE,test_case}}, {?eh,tc_done,{skip_init_per_group_SUITE,test_case,ok}}, - {?eh,test_stats,{1,0,{1,0}}}, + {?eh,test_stats,{1,0,{2,0}}}, {?eh,tc_start, {skip_init_per_group_SUITE,{end_per_group,right,[]}}}, {?eh,tc_done, @@ -351,7 +354,7 @@ test_events(skip_suite_in_spec) -> test_suite_events(skip_all_surefire_SUITE) ++ [{?eh,stop_logging,[]}]; test_events(skip_init_per_group) -> - [{?eh,start_logging,'_'},{?eh,start_info,{1,1,2}}] ++ + [{?eh,start_logging,'_'},{?eh,start_info,{1,1,3}}] ++ test_suite_events(skip_init_per_group_SUITE) ++ [{?eh,stop_logging,[]}]; test_events(Test) -> @@ -465,15 +468,17 @@ assert_lines(skip_init_per_group, A) -> ok; ("test_case", [{testcase,4}, {testsuite,1}, {testsuites,1}], "root.left") -> ok; - ("end_per_group", [{testcase,5}, {testsuite,1}, {testsuites,1}], "root.left") -> + ("test_case", [{testcase,5}, {testsuite,1}, {testsuites,1}], "root.left.nested_group") -> + ok; + ("end_per_group", [{testcase,6}, {testsuite,1}, {testsuites,1}], "root.left") -> ok; - ("init_per_group", [{testcase,6}, {testsuite,1}, {testsuites,1}], "root.right") -> + ("init_per_group", [{testcase,7}, {testsuite,1}, {testsuites,1}], "root.right") -> ok; - ("test_case", [{testcase,7}, {testsuite,1}, {testsuites,1}], "root.right") -> + ("test_case", [{testcase,8}, {testsuite,1}, {testsuites,1}], "root.right") -> ok; - ("end_per_group", [{testcase,8}, {testsuite,1}, {testsuites,1}], "root.right") -> + ("end_per_group", [{testcase,9}, {testsuite,1}, {testsuites,1}], "root.right") -> ok; - ("end_per_group", [{testcase,9}, {testsuite,1}, {testsuites,1}], "root") -> + ("end_per_group", [{testcase,10}, {testsuite,1}, {testsuites,1}], "root") -> ok; (Tc, TcParents, TcGroupPath) -> exit({wrong_grouppath, [{tc, Tc}, diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_init_per_group_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/skip_init_per_group_SUITE.erl index e97b105787b5..46daabc79611 100644 --- a/lib/common_test/test/ct_surefire_SUITE_data/skip_init_per_group_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_init_per_group_SUITE.erl @@ -35,7 +35,8 @@ all() -> groups() -> [{root, [], [{group, left}, {group, right}]}, - {left, [], [test_case]}, + {left, [], [test_case, {group, nested_group}]}, + {nested_group, [], [test_case]}, {right, [], [test_case]}]. test_case(_Config) ->