From 8be946d9a8a7241747a126524e3919a60f12b42a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 09:54:00 +0200 Subject: [PATCH 1/7] ct_master: Don't refresh logs at the end of run The ct_run:run_test function already takes care of the node's logs. The ct_master_logs module takes care of ct_master itself. --- lib/common_test/src/ct_master.erl | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 271b834fc33e..0670fc01a7d2 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -534,7 +534,6 @@ init_master2(Parent,NodeOptsList,LogDirs) -> Parent ! {self(),Result}. master_loop(#state{node_ctrl_pids=[], - logdirs=LogDirs, results=Finished}) -> Str = lists:map(fun({Node,Result}) -> @@ -543,7 +542,6 @@ master_loop(#state{node_ctrl_pids=[], end,lists:reverse(Finished)), log(all,"TEST RESULTS","~ts", [Str]), log(all,"Info","Updating log files",[]), - refresh_logs(LogDirs,[]), ct_master_event:stop(), ct_master_logs:stop(), @@ -738,34 +736,6 @@ master_progress(NodeCtrlPids,Results) -> Results ++ lists:map(fun({_Pid,Node}) -> {Node,ongoing} end,NodeCtrlPids). - -%% refresh those dirs where more than one node has written logs -refresh_logs([D|Dirs],Refreshed) -> - case lists:member(D,Dirs) of - true -> - case lists:keymember(D,1,Refreshed) of - true -> - refresh_logs(Dirs,Refreshed); - false -> - {ok,Cwd} = file:get_cwd(), - case catch ct_run:refresh_logs(D, unknown) of - {'EXIT',Reason} -> - ok = file:set_cwd(Cwd), - refresh_logs(Dirs,[{D,{error,Reason}}|Refreshed]); - Result -> - refresh_logs(Dirs,[{D,Result}|Refreshed]) - end - end; - false -> - refresh_logs(Dirs,Refreshed) - end; -refresh_logs([],Refreshed) -> - Str = - lists:map(fun({D,Result}) -> - io_lib:format("Refreshing logs in ~tp... ~tp", - [D,Result]) - end,Refreshed), - log(all,"Info","~ts", [Str]). %%%----------------------------------------------------------------- %%% NODE CONTROLLER, runs and controls tests on a test node. From 9ca4b7a13844185c5198e3d9e9dbf05c00d7dea2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 10:29:35 +0200 Subject: [PATCH 2/7] ct_master: Fix the master_runs.html css file paths Needed to file:set_cwd like in normal CT. --- lib/common_test/src/ct_master_logs.erl | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 1462966ac141..a694e863b712 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -130,8 +130,12 @@ init(Parent,LogDir,Nodes) -> end end, + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(LogDir), _ = make_all_runs_index(LogDir), CtLogFd = open_ct_master_log(RunDirAbs), + ok = file:set_cwd(Cwd), + NodeStr = lists:flatten(lists:map(fun(N) -> atom_to_list(N) ++ " " @@ -183,7 +187,10 @@ loop(State) -> lists:foreach(Fun,List), loop(State); {make_all_runs_index,From} -> + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(State#state.logdir), _ = make_all_runs_index(State#state.logdir), + ok = file:set_cwd(Cwd), return(From,State#state.logdir), loop(State); {{nodedir,Node,RunDir},From} -> @@ -191,7 +198,10 @@ loop(State) -> return(From,ok), loop(State); stop -> + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(State#state.logdir), _ = make_all_runs_index(State#state.logdir), + ok = file:set_cwd(Cwd), io:format(State#state.log_fd, int_header()++int_footer(), [log_timestamp(?now),"Finished!"]), From 63af8ed262925dd4ca2d66376a7894ec72e8a896 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 10:44:16 +0200 Subject: [PATCH 3/7] ct_master: Fix a small artefact in master_runs.html --- lib/common_test/src/ct_master_logs.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index a694e863b712..931e1b512619 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -422,7 +422,7 @@ footer() -> "Copyright © ", year(), " Open Telecom Platform", xhtml("
\n", "
\n"), - "Updated: ", current_time(), "<--!/date-->", + "Updated: ", current_time(), "", xhtml("
\n", "
\n"), xhtml("

\n", "\n"), "\n" From 87e55750e50ca41fc2b7869042555cfc4de08669 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 10:54:15 +0200 Subject: [PATCH 4/7] ct_master: Handle all testspec instructions Before this commit the CT docs were lying as ct_master only handled a small number of testspec instructions. This commit fixes that. --- lib/common_test/src/ct_master.erl | 182 +++++++++++++++++++----------- 1 file changed, 114 insertions(+), 68 deletions(-) diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 0670fc01a7d2..7814847ebae9 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -177,23 +177,14 @@ run([TS|TestSpecs],AllowUserTerms,InclNodes,ExclNodes) when is_list(TS), Tests -> RunResult = lists:map( - fun({Specs,TSRec=#testspec{logdir=AllLogDirs, - config=StdCfgFiles, - userconfig=UserCfgFiles, - include=AllIncludes, - init=AllInitOpts, - event_handler=AllEvHs}}) -> - AllCfgFiles = - {StdCfgFiles,UserCfgFiles}, + fun({Specs,TSRec=#testspec{}}) -> RunSkipPerNode = ct_testspec:prepare_tests(TSRec), RunSkipPerNode2 = exclude_nodes(ExclNodes,RunSkipPerNode), TSList = if is_integer(hd(TS)) -> [TS]; true -> TS end, - {Specs,run_all(RunSkipPerNode2,AllLogDirs, - AllCfgFiles,AllEvHs, - AllIncludes,[],[],AllInitOpts,TSList)} + {Specs,run_all(RunSkipPerNode2,TSRec,[],[],TSList)} end, Tests), RunResult ++ run(TestSpecs,AllowUserTerms,InclNodes,ExclNodes) end; @@ -258,19 +249,11 @@ run_on_node([TS|TestSpecs],AllowUserTerms,Node) when is_list(TS),is_atom(Node) - Tests -> RunResult = lists:map( - fun({Specs,TSRec=#testspec{logdir=AllLogDirs, - config=StdCfgFiles, - init=AllInitOpts, - include=AllIncludes, - userconfig=UserCfgFiles, - event_handler=AllEvHs}}) -> - AllCfgFiles = {StdCfgFiles,UserCfgFiles}, + fun({Specs,TSRec=#testspec{}}) -> {Run,Skip} = ct_testspec:prepare_tests(TSRec,Node), TSList = if is_integer(hd(TS)) -> [TS]; true -> TS end, - {Specs,run_all([{Node,Run,Skip}],AllLogDirs, - AllCfgFiles,AllEvHs, - AllIncludes, [],[],AllInitOpts,TSList)} + {Specs,run_all([{Node,Run,Skip}],TSRec,[],[],TSList)} end, Tests), RunResult ++ run_on_node(TestSpecs,AllowUserTerms,Node) end; @@ -291,53 +274,116 @@ run_on_node(TestSpecs,Node) -> -run_all([{Node,Run,Skip}|Rest],AllLogDirs, - {AllStdCfgFiles, AllUserCfgFiles}=AllCfgFiles, - AllEvHs,AllIncludes,NodeOpts,LogDirs,InitOptions,Specs) -> - LogDir = - lists:foldl(fun({N,Dir},_Found) when N == Node -> - Dir; - ({_N,_Dir},Found) -> - Found; - (Dir,".") -> - Dir; - (_Dir,Found) -> - Found - end,".",AllLogDirs), - - StdCfgFiles = - lists:foldr(fun({N,F},Fs) when N == Node -> [F|Fs]; - ({_N,_F},Fs) -> Fs; - (F,Fs) -> [F|Fs] - end,[],AllStdCfgFiles), - UserCfgFiles = +run_all([{Node,Run,Skip}|Rest],TSRec=#testspec{label = Labels, +% profile = Profiles, + logdir = LogDirs, + logopts = LogOptsList, + basic_html = BHs, + esc_chars = EscChs, + stylesheet = SSs, + verbosity = VLvls, + silent_connections = SilentConnsList, + cover = CoverFs, + cover_stop = CoverStops, + config = Cfgs, + userconfig = UsrCfgs, + event_handler = EvHs, + ct_hooks = CTHooks, + ct_hooks_order = CTHooksOrder0, + enable_builtin_hooks = EnableBuiltinHooks0, + auto_compile = ACs, + abort_if_missing_suites = AiMSs, + include = Incl, + multiply_timetraps = MTs, + scale_timetraps = STs, + create_priv_dir = PDs}, + NodeOpts,LogDirsRun,Specs) -> + %% We mirror ct_run:get_data_for_node to retrieve data from #testspec, + %% but set the default values where appropriate. + Label = proplists:get_value(Node, Labels), +% Profile = proplists:get_value(Node, Profiles), + LogDir = case proplists:get_value(Node, LogDirs) of + undefined -> "."; + Dir -> Dir + end, + LogOpts = case proplists:get_value(Node, LogOptsList) of + undefined -> []; + LOs -> LOs + end, + BasicHtml = proplists:get_value(Node, BHs, false), + EscChars = proplists:get_value(Node, EscChs, true), + Stylesheet = proplists:get_value(Node, SSs), + Verbosity = case proplists:get_value(Node, VLvls) of + undefined -> []; + Lvls -> Lvls + end, + SilentConns = case proplists:get_value(Node, SilentConnsList) of + undefined -> []; + SCs -> SCs + end, + Cover = proplists:get_value(Node, CoverFs), + CoverStop = proplists:get_value(Node, CoverStops, true), + MT = proplists:get_value(Node, MTs, 1), + ST = proplists:get_value(Node, STs, false), + CreatePrivDir = proplists:get_value(Node, PDs, auto_per_run), + %% For these two values we can't exactly mirror get_data_for_node. + ConfigFiles = + lists:foldr(fun({N,F},Fs) when N == Node -> [F|Fs]; + ({_N,_F},Fs) -> Fs; + (F,Fs) -> [F|Fs] + end,[],Cfgs), + UsrConfigFiles = lists:foldr(fun({N,F},Fs) when N == Node -> [{userconfig, F}|Fs]; - ({_N,_F},Fs) -> Fs; - (F,Fs) -> [{userconfig, F}|Fs] - end,[],AllUserCfgFiles), - - Includes = lists:foldr(fun({N,I},Acc) when N =:= Node -> - [I|Acc]; - ({_,_},Acc) -> - Acc; - (I,Acc) -> - [I | Acc] - end, [], AllIncludes), - EvHs = - lists:foldr(fun({N,H,A},Hs) when N == Node -> [{H,A}|Hs]; - ({_N,_H,_A},Hs) -> Hs; - ({H,A},Hs) -> [{H,A}|Hs] - end,[],AllEvHs), - - NO = {Node,[{prepared_tests,{Run,Skip},Specs}, - {logdir,LogDir}, - {include, Includes}, - {config,StdCfgFiles}, - {event_handler,EvHs}] ++ UserCfgFiles}, - run_all(Rest,AllLogDirs,AllCfgFiles,AllEvHs,AllIncludes, - [NO|NodeOpts],[LogDir|LogDirs],InitOptions,Specs); -run_all([],AllLogDirs,_,AllEvHs,_AllIncludes, - NodeOpts,LogDirs,InitOptions,Specs) -> + ({_N,_F},Fs) -> Fs; + (F,Fs) -> [{userconfig, F}|Fs] + end,[],UsrCfgs), + EvHandlers = [{H,A} || {N,H,A} <- EvHs, N==Node], + FiltCTHooks = [Hook || {N,Hook} <- CTHooks, N==Node], + CTHooksOrder = case CTHooksOrder0 of + undefined -> test; + _ -> CTHooksOrder0 + end, + EnableBuiltinHooks = case EnableBuiltinHooks0 of + undefined -> true; + _ -> EnableBuiltinHooks0 + end, + AutoCompile = proplists:get_value(Node, ACs, true), + AbortIfMissing = proplists:get_value(Node, AiMSs, false), + Include = [I || {N,I} <- Incl, N==Node], + %% We then build the ct:run_test/1 options list. + RunTestOpts0 = + [{label, Label} || Label =/= undefined] ++ + [{stylesheet, Stylesheet} || Stylesheet =/= undefined] ++ + [{cover, Cover} || Cover =/= undefined] ++ + UsrConfigFiles, + RunTestOpts = [ +% {profile, Profile}, + {logdir, LogDir}, + {logopts, LogOpts}, + {basic_html, BasicHtml}, + {esc_chars, EscChars}, + {verbosity, Verbosity}, + {silent_connections, SilentConns}, + {cover_stop, CoverStop}, + {config, ConfigFiles}, + {event_handler, EvHandlers}, + {ct_hooks, FiltCTHooks}, + {ct_hooks_order, CTHooksOrder}, + {enable_builtin_hooks, EnableBuiltinHooks}, + {auto_compile, AutoCompile}, + {abort_if_missing_suites, AbortIfMissing}, + {include, Include}, + {multiply_timetraps, MT}, + {scale_timetraps, ST}, + {create_priv_dir, CreatePrivDir} + |RunTestOpts0], + NO = {Node,[{prepared_tests,{Run,Skip},Specs}|RunTestOpts]}, + run_all(Rest,TSRec,[NO|NodeOpts],[LogDir|LogDirsRun],Specs); +run_all([],#testspec{ + logdir=AllLogDirs, + init=InitOptions, + event_handler=AllEvHs}, + NodeOpts,LogDirsRun,Specs) -> Handlers = [{H,A} || {Master,H,A} <- AllEvHs, Master == master], MasterLogDir = case lists:keysearch(master,1,AllLogDirs) of {value,{_,Dir}} -> Dir; @@ -345,7 +391,7 @@ run_all([],AllLogDirs,_,AllEvHs,_AllIncludes, end, log(tty,"Master Logdir","~ts",[MasterLogDir]), start_master(lists:reverse(NodeOpts),Handlers,MasterLogDir, - LogDirs,InitOptions,Specs), + LogDirsRun,InitOptions,Specs), ok. From 47c98c1694cc86a965d748bcabd199cacec44319 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 10:57:04 +0200 Subject: [PATCH 5/7] ct_master: Sort the results printout from ct_master It makes more sense to sort by node name, than to have the results in the order they finished. --- lib/common_test/src/ct_master.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 7814847ebae9..b3ccb3ba4b27 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -585,7 +585,7 @@ master_loop(#state{node_ctrl_pids=[], lists:map(fun({Node,Result}) -> io_lib:format("~-40.40.*ts~tp\n", [$_,atom_to_list(Node),Result]) - end,lists:reverse(Finished)), + end,lists:sort(Finished)), log(all,"TEST RESULTS","~ts", [Str]), log(all,"Info","Updating log files",[]), From 68a158cbb11e89a8e092d16807284a59e213bba1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 11:01:46 +0200 Subject: [PATCH 6/7] ct_master: Return results from ct_master:run Breaking change: instead of returning just `ok` to indicate that the spec file was handled, we return an OK tuple with the results of the tests (number of successful, failed, user and auto skipped tests). This allows the caller to know whether any test error occurred. --- lib/common_test/src/ct_master.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index b3ccb3ba4b27..a34dfe65d1bd 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -391,8 +391,7 @@ run_all([],#testspec{ end, log(tty,"Master Logdir","~ts",[MasterLogDir]), start_master(lists:reverse(NodeOpts),Handlers,MasterLogDir, - LogDirsRun,InitOptions,Specs), - ok. + LogDirsRun,InitOptions,Specs). -doc """ @@ -580,18 +579,19 @@ init_master2(Parent,NodeOptsList,LogDirs) -> Parent ! {self(),Result}. master_loop(#state{node_ctrl_pids=[], - results=Finished}) -> + results=Finished0}) -> + Finished = lists:sort(Finished0), Str = lists:map(fun({Node,Result}) -> io_lib:format("~-40.40.*ts~tp\n", [$_,atom_to_list(Node),Result]) - end,lists:sort(Finished)), + end,Finished), log(all,"TEST RESULTS","~ts", [Str]), log(all,"Info","Updating log files",[]), ct_master_event:stop(), ct_master_logs:stop(), - ok; + {ok, Finished}; master_loop(State=#state{node_ctrl_pids=NodeCtrlPids, results=Results, From fd46027713fa7faa17088ab2949f5acf83012e84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Hoguin?= Date: Wed, 16 Oct 2024 11:08:37 +0200 Subject: [PATCH 7/7] ct_master: Print auto-skipped and failed test cases At the end of a ct_master run. This uses the builtin CT Master event handler to gather the results. --- lib/common_test/src/ct_master.erl | 23 ++++++++++++++++++ lib/common_test/src/ct_master_event.erl | 31 +++++++++++++++++++++---- 2 files changed, 49 insertions(+), 5 deletions(-) diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index a34dfe65d1bd..10b91242d159 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -589,6 +589,9 @@ master_loop(#state{node_ctrl_pids=[], log(all,"TEST RESULTS","~ts", [Str]), log(all,"Info","Updating log files",[]), + %% Print the failed and auto skipped tests. + master_print_summary(), + ct_master_event:stop(), ct_master_logs:stop(), {ok, Finished}; @@ -706,6 +709,26 @@ master_loop(State=#state{node_ctrl_pids=NodeCtrlPids, end. +master_print_summary() -> + #{ + auto_skipped := AutoSkipped, + failed := Failed + } = ct_master_event:get_results(), + master_print_summary_for("Auto skipped test cases", AutoSkipped), + master_print_summary_for("Failed test cases", Failed), + ok. + +master_print_summary_for(Title,List) -> + _ = case List of + [] -> ok; + _ -> + Chars = [ + io_lib:format("Node: ~w~nCase: ~w:~w~nReason: ~p~n~n", + [Node, Suite, FuncOrGroup, Reason]) + || {Node, Suite, FuncOrGroup, Reason} <- List], + log(all,Title,Chars,[]) + end, + ok. update_queue(take,Node,From,Lock={Op,Resource},Locks,Blocked) -> %% Locks: [{{Operation,Resource},Node},...] diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index d2aa14d607f6..7e8b59eb0feb 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -22,7 +22,9 @@ %%% %%% This module implements an event handler that the CT Master %%% uses to handle status and progress notifications sent to the -%%% master node during test runs. This module may be used as a +%%% master node during test runs. It also keeps track of the +%%% details of failures which are used by the CT Master to print +%%% a summary at the end of its run. This module may be used as a %%% template for other event handlers that can be plugged in to %%% handle logging and reporting on the master node. -module(ct_master_event). @@ -32,7 +34,7 @@ %% API -export([start_link/0, add_handler/0, add_handler/1, stop/0]). --export([notify/1, sync_notify/1]). +-export([notify/1, sync_notify/1, get_results/0]). %% gen_event callbacks -export([init/1, handle_event/2, handle_call/2, @@ -42,7 +44,7 @@ -include("ct_util.hrl"). --record(state, {}). +-record(state, {auto_skipped=[], failed=[]}). %%==================================================================== %% gen_event callbacks @@ -108,6 +110,13 @@ notify(Event) -> sync_notify(Event) -> gen_event:sync_notify(?CT_MEVMGR_REF,Event). +%%-------------------------------------------------------------------- +%% Function: sync_notify(Event) -> Results +%% Description: Get the results for auto-skipped and failed test cases. +%%-------------------------------------------------------------------- +get_results() -> + gen_event:call(?CT_MEVMGR_REF,?MODULE,get_results). + %%==================================================================== %% gen_event callbacks %%==================================================================== @@ -135,10 +144,10 @@ handle_event(#event{name=start_logging,node=Node,data=RunDir},State) -> ct_master_logs:nodedir(Node,RunDir), {ok,State}; -handle_event(#event{name=Name,node=Node,data=Data},State) -> +handle_event(Event=#event{name=Name,node=Node,data=Data},State) -> print("~n=== ~w ===~n", [?MODULE]), print("~tw on ~w: ~tp~n", [Name,Node,Data]), - {ok,State}. + {ok,maybe_store_event(Event,State)}. %%-------------------------------------------------------------------- %% Function: @@ -150,6 +159,11 @@ handle_event(#event{name=Name,node=Node,data=Data},State) -> %% gen_event:call/3,4, this function is called for the specified event %% handler to handle the request. %%-------------------------------------------------------------------- +handle_call(get_results,State=#state{auto_skipped=AutoSkipped,failed=Failed}) -> + {ok,#{ + auto_skipped => lists:sort(AutoSkipped), + failed => lists:sort(Failed) + },State}; handle_call(flush,State) -> case process_info(self(),message_queue_len) of {message_queue_len,0} -> @@ -194,3 +208,10 @@ code_change(_OldVsn,State,_Extra) -> print(_Str,_Args) -> % io:format(_Str,_Args), ok. + +maybe_store_event(#event{name=tc_done,node=Node,data={Suite,FuncOrGroup,{auto_skipped,Reason}}},State=#state{auto_skipped=Acc}) -> + State#state{auto_skipped=[{Node,Suite,FuncOrGroup,Reason}|Acc]}; +maybe_store_event(#event{name=tc_done,node=Node,data={Suite,FuncOrGroup,{failed,Reason}}},State=#state{failed=Acc}) -> + State#state{failed=[{Node,Suite,FuncOrGroup,Reason}|Acc]}; +maybe_store_event(_Event,State) -> + State.