From b24db4ba1763de5b2c9522e7c0b219d5a3d3a1c0 Mon Sep 17 00:00:00 2001 From: Johannes Christ Date: Thu, 31 Aug 2023 10:22:59 +0200 Subject: [PATCH] ct: Use custom stylesheets in test overview pages --- lib/common_test/src/ct_framework.erl | 2 +- lib/common_test/src/ct_logs.erl | 191 ++++++++++++++++----------- lib/common_test/src/ct_master.erl | 2 +- lib/common_test/src/ct_run.erl | 24 ++-- lib/common_test/src/ct_util.erl | 67 +++++----- 5 files changed, 164 insertions(+), 122 deletions(-) diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 8c84a8805406..dd5ca31a856e 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1420,7 +1420,7 @@ report(What,Data) -> %% top level test index page needs to be refreshed TestName = filename:basename(?val(topdir, Data), ".logs"), RunDir = ?val(rundir, Data), - _ = ct_logs:make_all_suites_index({TestName,RunDir}), + _ = ct_logs:make_all_suites_index({TestName,RunDir},unknown), ok; tests_start -> ok; diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 679d9109423b..07108cf7c90d 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -27,14 +27,14 @@ -module(ct_logs). --export([init/2, close/2, init_tc/1, end_tc/1]). +-export([init/3, close/3, init_tc/1, end_tc/1]). -export([register_groupleader/2, unregister_groupleader/1]). -export([get_log_dir/0, get_log_dir/1]). -export([log/3, start_log/1, cont_log/2, cont_log_no_timestamp/2, end_log/0]). -export([set_stylesheet/2, clear_stylesheet/1]). -export([add_external_logs/1, add_link/3]). -export([make_last_run_index/0]). --export([make_all_suites_index/1,make_all_runs_index/1]). +-export([make_all_suites_index/2,make_all_runs_index/2]). -export([get_ts_html_wrapper/5, escape_chars/1]). -export([xhtml/2, locate_priv_file/1, make_relative/1]). -export([insert_javascript/1]). @@ -82,8 +82,9 @@ tests = []}). %%%----------------------------------------------------------------- -%%% -spec init(Mode, Verbosity) -> Result +%%% -spec init(Mode, Verbosity, CustomStylesheet) -> Result %%% Mode = normal | interactive +%%% CustomStylesheet = string() | undefined | unknown %%% Result = {StartTime,LogDir} %%% StartTime = term() %%% LogDir = string() @@ -94,9 +95,9 @@ %%% started. A new directory named ct_run. is created %%% and all logs are stored under this directory. %%% -init(Mode, Verbosity) -> +init(Mode, Verbosity, CustomStylesheet) -> Self = self(), - Pid = spawn_link(fun() -> logger(Self, Mode, Verbosity) end), + Pid = spawn_link(fun() -> logger(Self, Mode, Verbosity, CustomStylesheet) end), MRef = erlang:monitor(process,Pid), receive {started,Pid,Result} -> @@ -127,11 +128,11 @@ datestr_from_dirname([]) -> "". %%%----------------------------------------------------------------- -%%% -spec close(Info, StartDir) -> ok +%%% -spec close(Info, StartDir, CustomStylesheet) -> ok %%% %%% Create index pages with test results and close the CT Log %%% (tool-internal use only). -close(Info, StartDir) -> +close(Info, StartDir, CustomStylesheet) -> %% close executes on the ct_util process, not on the logger process %% so we need to use a local copy of the log cache data LogCacheBin = @@ -175,13 +176,13 @@ close(Info, StartDir) -> Error -> io:format("Warning! Cleanup failed: ~tp~n", [Error]) end, - _ = make_all_suites_index(stop), - make_all_runs_index(stop), + _ = make_all_suites_index(stop, CustomStylesheet), + make_all_runs_index(stop, CustomStylesheet), Cache2File(); true -> ok = file:set_cwd(".."), - _ = make_all_suites_index(stop), - make_all_runs_index(stop), + _ = make_all_suites_index(stop, CustomStylesheet), + make_all_runs_index(stop, CustomStylesheet), Cache2File(), case ct_util:get_profile_data(browser, StartDir) of undefined -> @@ -201,6 +202,11 @@ close(Info, StartDir) -> end, ok. +%%%----------------------------------------------------------------- +%%% -spec get_stylesheet() -> string() | undefined +get_stylesheet() -> + call(get_stylesheet). + %%%----------------------------------------------------------------- %%% -spec set_stylesheet(TC,SSFile) -> ok set_stylesheet(TC, SSFile) -> @@ -658,7 +664,7 @@ log_timestamp({MS,S,US}) -> tc_esc_chars, log_index}). -logger(Parent, Mode, Verbosity) -> +logger(Parent, Mode, Verbosity, CustomStylesheet) -> register(?MODULE,self()), ct_util:mark_process(), %%! Below is a temporary workaround for the limitation of @@ -726,7 +732,7 @@ logger(Parent, Mode, Verbosity) -> {MiscIoHeader,MiscIoFooter} = case get_ts_html_wrapper("Pre/post-test I/O log", Dir, false, - Dir, undefined, utf8) of + Dir, undefined, utf8, CustomStylesheet) of {basic_html,UH,UF} -> {UH,UF}; {xhtml,UH,UF} -> @@ -747,15 +753,15 @@ logger(Parent, Mode, Verbosity) -> ct_event:notify(#event{name=start_logging,node=node(), data=AbsDir}), - make_all_runs_index(start), - _ = make_all_suites_index(start), + make_all_runs_index(start, CustomStylesheet), + _ = make_all_suites_index(start, CustomStylesheet), case Mode of interactive -> interactive_link(); _ -> ok end, ok = file:set_cwd(Dir), - _ = make_last_run_index(Time), - CtLogFd = open_ctlog(?misc_io_log), + _ = make_last_run_index(Time, CustomStylesheet), + CtLogFd = open_ctlog(?misc_io_log, CustomStylesheet), io:format(CtLogFd,int_header()++int_footer(), [log_timestamp(?now),"Common Test Logger started"]), Parent ! {started,self(),{Time,filename:absname("")}}, @@ -788,6 +794,7 @@ logger(Parent, Mode, Verbosity) -> tc_groupleaders=[], async_print_jobs=[], tc_esc_chars=TcEscChars, + stylesheet=CustomStylesheet, log_index=1}). copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> @@ -855,7 +862,7 @@ logger_loop(State) -> _ = if not RefreshLog -> ok; true -> - make_last_run_index(State#logger_state.start_time) + make_last_run_index(State#logger_state.start_time, State#logger_state.stylesheet) end, return(From,ok), logger_loop(State#logger_state{tc_groupleaders = TCGLs}); @@ -879,9 +886,12 @@ logger_loop(State) -> return(From,{ok,filename:basename(State#logger_state.log_dir)}), logger_loop(State); {make_last_run_index,From} -> - _ = make_last_run_index(State#logger_state.start_time), + _ = make_last_run_index(State#logger_state.start_time, State#logger_state.stylesheet), return(From,get(ct_log_cache)), logger_loop(State); + {get_stylesheet, From} -> + return(From, State#logger_state.stylesheet), + logger_loop(State); {set_stylesheet,_,SSFile} when State#logger_state.stylesheet == SSFile -> logger_loop(State); @@ -1152,9 +1162,9 @@ set_evmgr_gl(GL) -> EvMgrPid -> group_leader(GL,EvMgrPid) end. -open_ctlog(MiscIoName) -> +open_ctlog(MiscIoName, CustomStylesheet) -> {ok,Fd} = file:open(?ct_log_name,[write,{encoding,utf8}]), - io:format(Fd, "~ts", [header("Common Test Framework Log", {[],[1,2],[]})]), + io:format(Fd, "~ts", [header("Common Test Framework Log", "", {[],[1,2],[]}, CustomStylesheet)]), case file:consult(ct_run:variables_file_name("../")) of {ok,Vars} -> io:format(Fd, "~ts", [config_table(Vars)]); @@ -1197,36 +1207,43 @@ print_style(Fd, IoFormat, undefined) -> end; print_style(Fd, IoFormat, StyleSheet) -> - case file:read_file(StyleSheet) of + case stylesheet_to_style_html(StyleSheet) of + {ok, Markup} -> + IoFormat(Fd, Markup, []); + {error, Reason} -> + print_style_error(Fd, IoFormat, StyleSheet, Reason) + end. + +print_style_error(Fd, IoFormat, StyleSheet, Reason) -> + IO = io_lib:format("\n\n", + [StyleSheet,Reason]), + IoFormat(Fd, IO, []), + print_style(Fd, IoFormat, undefined). + +%% Convert a stylesheet on disk to inline HTML `", [dotall,caseless,{capture,all,list}]) of nomatch -> case re:run(Str,"",[caseless,{capture,all,list}]) of nomatch -> - IoFormat(Fd,"\n",[Str]); + {ok, io_lib:fwrite("\n",[Str])}; {match,[" - print_style_error(Fd, IoFormat, - StyleSheet, - missing_style_start_tag); + {error, missing_style_start_tag}; {match,[_]} -> - print_style_error(Fd, IoFormat, - StyleSheet,missing_style_end_tag) + {error, missing_style_end_tag} end; {match,[Style]} -> - IoFormat(Fd,"~ts\n",[Style]) + {ok, io_lib:fwrite("~ts\n", [Style])} end; - {error,Reason} -> - print_style_error(Fd,IoFormat,StyleSheet,Reason) + {error, _Reason} = Result -> + Result end. -print_style_error(Fd, IoFormat, StyleSheet, Reason) -> - IO = io_lib:format("\n\n", - [StyleSheet,Reason]), - IoFormat(Fd, IO, []), - print_style(Fd, IoFormat, undefined). - close_ctlog(Fd) -> io:format(Fd, "\n\n", []), io:format(Fd, "~ts", [[xhtml("

\n", "

\n") | footer()]]), @@ -1258,11 +1275,11 @@ cloaked_true() -> %%%----------------------------------------------------------------- %%% Make an index page for the last run -make_last_run_index(StartTime) -> +make_last_run_index(StartTime,CustomStylesheet) -> IndexName = ?index_name, AbsIndexName = ?abs(IndexName), Result = - case catch make_last_run_index1(StartTime,IndexName) of + case catch make_last_run_index1(StartTime,IndexName,CustomStylesheet) of {'EXIT', Reason} -> io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), io:format("~tp~n", [Reason]), @@ -1281,7 +1298,7 @@ make_last_run_index(StartTime) -> end, Result. -make_last_run_index1(StartTime,IndexName) -> +make_last_run_index1(StartTime,IndexName,CustomStylesheet) -> Logs1 = case filelib:wildcard([$*|?logdir_ext]) of [Log] -> % first test @@ -1305,7 +1322,7 @@ make_last_run_index1(StartTime,IndexName) -> _ -> undefined end, {ok,Index0,Totals} = make_last_run_index(Logs1, - index_header(Label,StartTime), + index_header(Label,StartTime,CustomStylesheet), 0, 0, 0, 0, 0, Missing), %% write current Totals to file, later to be used in all_runs log write_totals_file(?totals_name,Label,Logs1,Totals), @@ -1575,16 +1592,16 @@ term_to_text(Term) -> %%% Headers and footers. -index_header(Label, StartTime) -> +index_header(Label, StartTime, CustomStylesheet) -> Head = case Label of undefined -> header("Test Results", format_time(StartTime), - {[],[1],[2,3,4,5]}); + {[],[1],[2,3,4,5]}, CustomStylesheet); _ -> header("Test Results for '" ++ Label ++ "'", format_time(StartTime), - {[],[1],[2,3,4,5]}) + {[],[1],[2,3,4,5]}, CustomStylesheet) end, Cover = case filelib:is_regular(?abs(?coverlog_name)) of @@ -1621,18 +1638,18 @@ index_header(Label, StartTime) -> "Missing", xhtml("
", "
"), "Suites\n", xhtml("", "\n\n\n")]]. -all_suites_index_header() -> +all_suites_index_header(CustomStylesheet) -> {ok,Cwd} = file:get_cwd(), - all_suites_index_header(Cwd). + all_suites_index_header(Cwd, CustomStylesheet). -all_suites_index_header(IndexDir) -> +all_suites_index_header(IndexDir, CustomStylesheet) -> LogDir = filename:basename(IndexDir), AllRuns = xhtml(["All test runs in \"" ++ LogDir ++ "\""], "ALL RUNS"), AllRunsLink = xhtml(["",AllRuns,"\n"], [""]), - [header("Test Results", {[3],[1,2,8,9,10],[4,5,6,7]}) | + [header("Test Results", "", {[3],[1,2,8,9,10],[4,5,6,7]}, CustomStylesheet) | ["
\n", AllRunsLink, xhtml("

\n", "

\n"), @@ -1654,7 +1671,7 @@ all_suites_index_header(IndexDir) -> "Old Runs\n", xhtml("", "\n\n\n")]]. -all_runs_header() -> +all_runs_header(CustomStylesheet) -> {ok,Cwd} = file:get_cwd(), LogDir = filename:basename(Cwd), Title = "All test runs in \"" ++ LogDir ++ "\"", @@ -1664,7 +1681,7 @@ all_runs_header() -> "TEST INDEX PAGE\n"]), xhtml("
\n", "

\n")], - [header(Title, {[1],[2,3,5],[4,6,7,8,9,10]}) | + [header(Title, "", {[1],[2,3,5],[4,6,7,8,9,10]}, CustomStylesheet) | ["
\n", IxLink, xhtml(["\n"], @@ -1684,12 +1701,7 @@ all_runs_header() -> "\n", xhtml("", "\n\n\n")]]. -header(Title, TableCols) -> - header1(Title, "", TableCols). -header(Title, SubTitle, TableCols) -> - header1(Title, SubTitle, TableCols). - -header1(Title, SubTitle, TableCols) -> +header(Title, SubTitle, TableCols, CustomStylesheet) -> SubTitleHTML = if SubTitle =/= "" -> ["
\n", "

" ++ SubTitle ++ "

\n", @@ -1704,6 +1716,7 @@ header1(Title, SubTitle, TableCols) -> TableSorterFile = xhtml(fun() -> "" end, fun() -> make_relative(locate_priv_file(?tablesorter_script)) end), + CustomCSSFileHtml = custom_stylesheet_header(CustomStylesheet), [xhtml(["\n", "\n"], [" xhtml("", ["\n"]), + CustomCSSFileHtml, xhtml("", ["\n"]), @@ -1735,6 +1749,26 @@ header1(Title, SubTitle, TableCols) -> "
\n", SubTitleHTML,"\n"]. +% This function may be called either internally via the logger +% process when it starts up - in which case we know the stylesheet +% already - or via a separate server, which will not have the +% stylesheet. In that case we will receive the stylesheet as `unknown` +% and can ask the logger for it. Having the logger ask itself would hang. +% If the user has not passed any stylesheet on the command line, the value +% `undefined` should be used. +-spec custom_stylesheet_header(string() | unknown | undefined) -> string(). +custom_stylesheet_header(unknown) -> + % Not known + custom_stylesheet_header(get_stylesheet()); +custom_stylesheet_header(undefined) -> + % Not configured + ""; +custom_stylesheet_header(Path) when is_list(Path) -> + case stylesheet_to_style_html(Path) of + {ok, StyleMarkup} -> xhtml("", StyleMarkup); + {error, _Reason} -> "" + end. + last_run_index_footer() -> AllRuns = filename:join("../",?all_runs_name), TestIndex = filename:join("../",?index_name), @@ -1929,7 +1963,7 @@ config_table1([]) -> [xhtml("","\n"),"
Missing
Suites
\n"]. -make_all_runs_index(When) -> +make_all_runs_index(When, CustomStylesheet) -> put(basic_html, basic_html()), AbsName = ?abs(?all_runs_name), notify_and_lock_file(AbsName), @@ -1968,11 +2002,11 @@ make_all_runs_index(When) -> case LogCacheInfo of {ok,LogCache} -> %% use the log cache file to generate the index - make_all_runs_from_cache(AbsName,DirsSorted,LogCache); + make_all_runs_from_cache(AbsName,DirsSorted,LogCache,CustomStylesheet); _WhyNot -> %% no cache file exists (or feature has been disabled) - Header = all_runs_header(), + Header = all_runs_header(CustomStylesheet), GetLogResult = fun(Dir,{RunData,LogTxt}) -> {Tot,XHTML,IxLink} = runentry(Dir, @@ -1999,8 +2033,8 @@ make_all_runs_index(When) -> end, Result. -make_all_runs_from_cache(AbsName, Dirs, LogCache) -> - Header = all_runs_header(), +make_all_runs_from_cache(AbsName, Dirs, LogCache, CustomStylesheet) -> + Header = all_runs_header(CustomStylesheet), %% Note that both Dirs and the cache is sorted! AllRunsDirs = dir_diff_all_runs(Dirs, LogCache), @@ -2392,7 +2426,7 @@ timestamp(Dir) -> %% Creates the top level index file. When == start | stop | refresh. %% A copy of the dir tree under logdir is saved temporarily as a result. -make_all_suites_index(When) when is_atom(When) -> +make_all_suites_index(When, CustomStylesheet) when is_atom(When) -> put(basic_html, basic_html()), AbsIndexName = ?abs(?index_name), notify_and_lock_file(AbsIndexName), @@ -2425,11 +2459,11 @@ make_all_suites_index(When) when is_atom(When) -> {ok,LogCache} -> %% use the log cache file to generate the index make_all_suites_index_from_cache(When,AbsIndexName, - LogDirs,LogCache); + LogDirs,LogCache,CustomStylesheet); _WhyNot -> %% no cache file exists (or feature has been disabled) Sorted = sort_and_filter_logdirs(LogDirs), - TempData = make_all_suites_index1(When,AbsIndexName,Sorted), + TempData = make_all_suites_index1(When,AbsIndexName,Sorted,CustomStylesheet), notify_and_unlock_file(AbsIndexName), %% save new cache file unless the feature is disabled @@ -2446,7 +2480,7 @@ make_all_suites_index(When) when is_atom(When) -> %% This updates the top level index file using data from the initial %% index file creation, saved temporarily in a table. -make_all_suites_index(NewTestData = {_TestName,DirName}) -> +make_all_suites_index(NewTestData = {_TestName,DirName}, CustomStylesheet) -> put(basic_html, basic_html()), %% AllLogDirs = [{TestName,Label,Missing, @@ -2468,7 +2502,8 @@ make_all_suites_index(NewTestData = {_TestName,DirName}) -> case catch make_all_suites_ix_temp(AbsIndexName, NewTestData, Label, - LogDirData) of + LogDirData, + CustomStylesheet) of {'EXIT',Reason} -> io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), io:format("~tp~n", [Reason]), @@ -2488,7 +2523,7 @@ make_all_suites_index(NewTestData = {_TestName,DirName}) -> notify_and_unlock_file(AbsIndexName), Result. -make_all_suites_index_from_cache(When, AbsIndexName, LogDirs, LogCache) -> +make_all_suites_index_from_cache(When, AbsIndexName, LogDirs, LogCache, CustomStylesheet) -> %% The structure of the cache: %% @@ -2506,7 +2541,7 @@ make_all_suites_index_from_cache(When, AbsIndexName, LogDirs, LogCache) -> TempData = if Sorted /= [] -> make_all_suites_index1(When,AbsIndexName, - Sorted); + Sorted,CustomStylesheet); true -> Data = LogCache1#log_cache.tests, ct_util:set_testdata_async({test_index,{AbsIndexName, @@ -2692,12 +2727,12 @@ update_tests_in_cache(TempData,LogCache=#log_cache{tests=Tests}) -> %% [{TestName,[IxDir|IxDirs]} | ...] (non-cached), or %% [{TestName,Label,Missing,{IxDir,Summary,URIs},IxDirs} | ...] (cached) %% -make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) -> +make_all_suites_index1(When, AbsIndexName, AllTestLogDirs, CustomStylesheet) -> IndexName = ?index_name, if When == start -> ok; true -> io:put_chars("Updating " ++ AbsIndexName ++ " ... ") end, - case catch make_all_suites_index2(IndexName, AllTestLogDirs) of + case catch make_all_suites_index2(IndexName, AllTestLogDirs, CustomStylesheet) of {'EXIT', Reason} -> io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), io:format("~tp~n", [Reason]), @@ -2723,10 +2758,10 @@ make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) -> {error, Err} end. -make_all_suites_index2(IndexName, AllTestLogDirs) -> +make_all_suites_index2(IndexName, AllTestLogDirs, CustomStylesheet) -> {ok,Index0,_Totals,TempData} = make_all_suites_index3(AllTestLogDirs, - all_suites_index_header(), + all_suites_index_header(CustomStylesheet), 0, 0, 0, 0, 0, [], []), Index = [Index0|all_suites_index_footer()], case force_write_file(IndexName, unicode:characters_to_binary(Index)) of @@ -2828,11 +2863,11 @@ make_all_suites_index3([], Result, TotSucc, TotFail, UserSkip, AutoSkip, {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}, lists:reverse(TempData)}. -make_all_suites_ix_temp(AbsIndexName, NewTestData, Label, AllTestLogDirs) -> +make_all_suites_ix_temp(AbsIndexName, NewTestData, Label, AllTestLogDirs, CustomStylesheet) -> AllTestLogDirs1 = insert_new_test_data(NewTestData, Label, AllTestLogDirs), IndexDir = filename:dirname(AbsIndexName), Index0 = make_all_suites_ix_temp1(AllTestLogDirs1, - all_suites_index_header(IndexDir), + all_suites_index_header(IndexDir, CustomStylesheet), 0, 0, 0, 0, 0), Index = [Index0|all_suites_index_footer()], case force_write_file(AbsIndexName, unicode:characters_to_binary(Index)) of @@ -3176,9 +3211,9 @@ make_relative1(DirTs, CwdTs) -> %%% -> {Mode,Header,Footer} %%% get_ts_html_wrapper(TestName, PrintLabel, Cwd, TableCols, Encoding) -> - get_ts_html_wrapper(TestName, undefined, PrintLabel, Cwd, TableCols, Encoding). + get_ts_html_wrapper(TestName, undefined, PrintLabel, Cwd, TableCols, Encoding, unknown). -get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> +get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding, CustomStylesheet) -> TestName1 = if is_list(TestName) -> lists:flatten(TestName); true -> @@ -3256,6 +3291,7 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> fun() -> make_relative(locate_priv_file(?css_default), Cwd) end), + CustomCSSFileHtml = custom_stylesheet_header(CustomStylesheet), JQueryFile = xhtml(fun() -> "" end, fun() -> make_relative(locate_priv_file(?jquery_script), @@ -3281,6 +3317,7 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> "charset=utf-8\">\n", "\n", + CustomCSSFileHtml, "\n", "\n"] ++ TableSorterScript ++ ["\n","\n", LabelStr, "\n"], diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 9fc169789c96..52e82078eaee 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -557,7 +557,7 @@ refresh_logs([D|Dirs],Refreshed) -> refresh_logs(Dirs,Refreshed); false -> {ok,Cwd} = file:get_cwd(), - case catch ct_run:refresh_logs(D) of + case catch ct_run:refresh_logs(D, unknown) of {'EXIT',Reason} -> ok = file:set_cwd(Cwd), refresh_logs(Dirs,[{D,{error,Reason}}|Refreshed]); diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index fa72f4e68acf..ddcbb4e90559 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -25,7 +25,7 @@ %% User interface -export([install/1,install/2,run/1,run/2,run/3,run_test/1, - run_testspec/1,step/3,step/4,refresh_logs/1]). + run_testspec/1,step/3,step/4,refresh_logs/2]). %% Misc internal API functions -export([variables_file_name/1,script_start1/2,run_test2/1, run_make/3]). @@ -369,7 +369,7 @@ script_start1(Parent, Args) -> %% send final results to starting process waiting in script_start/0 Parent ! {self(), Result}. -run_or_refresh(Opts = #opts{logdir = LogDir}, Args) -> +run_or_refresh(Opts = #opts{logdir = LogDir, stylesheet = CustomStylesheet}, Args) -> case proplists:get_value(refresh_logs, Args) of undefined -> script_start2(Opts, Args); @@ -383,12 +383,12 @@ run_or_refresh(Opts = #opts{logdir = LogDir}, Args) -> %% give the shell time to print version etc timer:sleep(500), io:nl(), - case catch ct_logs:make_all_runs_index(refresh) of + case catch ct_logs:make_all_runs_index(refresh, CustomStylesheet) of {'EXIT',ARReason} -> ok = file:set_cwd(Cwd), {error,{all_runs_index,ARReason}}; _ -> - case catch ct_logs:make_all_suites_index(refresh) of + case catch ct_logs:make_all_suites_index(refresh, CustomStylesheet) of {'EXIT',ASReason} -> ok = file:set_cwd(Cwd), {error,{all_suites_index,ASReason}}; @@ -705,6 +705,7 @@ script_start4(#opts{label = Label, profile = Profile, logopts = LogOpts, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, + stylesheet = CustomStylesheet, logdir = LogDir, testspec_files = Specs}, _Args) -> %% label - used by ct_logs @@ -723,7 +724,7 @@ script_start4(#opts{label = Label, profile = Profile, {enable_builtin_hooks,EnableBuiltinHooks}]) of ok -> _ = ct_util:start(interactive, LogDir, - add_verbosity_defaults(Verbosity)), + add_verbosity_defaults(Verbosity), CustomStylesheet), ct_util:set_testdata({logopts, LogOpts}), log_ts_names(Specs), io:nl(), @@ -893,7 +894,8 @@ run_test1(StartOpts) when is_list(StartOpts) -> all, StartOpts), application:set_env(common_test, keep_logs, KeepLogs), - ok = refresh_logs(?abs(RefreshDir)), + CustomStylesheet = proplists:get_value(stylesheet, StartOpts), + ok = refresh_logs(?abs(RefreshDir), CustomStylesheet), exit(done) end. @@ -1479,18 +1481,18 @@ get_data_for_node(#testspec{label = Labels, scale_timetraps = ST, create_priv_dir = CreatePrivDir}. -refresh_logs(LogDir) -> +refresh_logs(LogDir, CustomStylesheet) -> {ok,Cwd} = file:get_cwd(), case file:set_cwd(LogDir) of E = {error,_Reason} -> E; _ -> - case catch ct_logs:make_all_suites_index(refresh) of + case catch ct_logs:make_all_suites_index(refresh, CustomStylesheet) of {'EXIT',ASReason} -> ok = file:set_cwd(Cwd), {error,{all_suites_index,ASReason}}; _ -> - case catch ct_logs:make_all_runs_index(refresh) of + case catch ct_logs:make_all_runs_index(refresh, CustomStylesheet) of {'EXIT',ARReason} -> ok = file:set_cwd(Cwd), {error,{all_runs_index,ARReason}}; @@ -1652,7 +1654,7 @@ do_run(Tests, Misc, LogDir, LogOpts) when is_list(Misc), do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> #opts{label = Label, profile = Profile, - verbosity = VLvls} = Opts, + verbosity = VLvls, stylesheet = CustomStylesheet} = Opts, %% label - used by ct_logs TestLabel = if Label == undefined -> undefined; @@ -1689,7 +1691,7 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> "Note: TEST_SERVER_FRAMEWORK = " ++ Other)) end, Verbosity = add_verbosity_defaults(VLvls), - case ct_util:start(Opts#opts.logdir, Verbosity) of + case ct_util:start(Opts#opts.logdir, Verbosity, CustomStylesheet) of {error,interactive_mode} -> io:format("CT is started in interactive mode. " "To exit this mode, " diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 3816e202a498..cd40e891472c 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -26,7 +26,7 @@ %%% -module(ct_util). --export([start/0, start/1, start/2, start/3, +-export([start/0, start/1, start/3, start/4, stop/1, update_last_run_index/0]). -export([register_connection/4, unregister_connection/1, @@ -77,12 +77,13 @@ -define(default_verbosity, [{default,?MAX_VERBOSITY}, {'$unspecified',?MAX_VERBOSITY}]). +-define(default_custom_stylesheet, undefined). -record(suite_data, {key,name,value}). %%%----------------------------------------------------------------- start() -> - start(normal, ".", ?default_verbosity). + start(normal, ".", ?default_verbosity, ?default_custom_stylesheet). %%% -spec start(Mode) -> Pid | exit(Error) %%% Mode = normal | interactive %%% Pid = pid() @@ -98,18 +99,20 @@ start() -> %%% %%% See ct. start(LogDir) when is_list(LogDir) -> - start(normal, LogDir, ?default_verbosity); + start(normal, LogDir, ?default_verbosity, ?default_custom_stylesheet); start(Mode) -> - start(Mode, ".", ?default_verbosity). + start(Mode, ".", ?default_verbosity, ?default_custom_stylesheet). -start(LogDir, Verbosity) when is_list(LogDir) -> - start(normal, LogDir, Verbosity). +start(LogDir, Verbosity, CustomStylesheet) when is_list(LogDir) -> + start(normal, LogDir, Verbosity, CustomStylesheet). -start(Mode, LogDir, Verbosity) -> +start(Mode, LogDir, Verbosity, CustomStylesheet) -> case whereis(ct_util_server) of undefined -> S = self(), - Pid = spawn_link(fun() -> do_start(S, Mode, LogDir, Verbosity) end), + Pid = spawn_link(fun() -> + do_start(S, Mode, LogDir, Verbosity, CustomStylesheet) + end), receive {Pid,started} -> Pid; {Pid,Error} -> exit(Error); @@ -126,7 +129,7 @@ start(Mode, LogDir, Verbosity) -> end end. -do_start(Parent, Mode, LogDir, Verbosity) -> +do_start(Parent, Mode, LogDir, Verbosity, CustomStylesheet) -> process_flag(trap_exit,true), register(ct_util_server,self()), mark_process(), @@ -192,7 +195,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> ignore -> ok end, - {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), + {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity, CustomStylesheet), ct_event:notify(#event{name=test_start, node=node(), @@ -218,7 +221,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, - loop(Mode, [], StartDir). + loop(Mode, [], StartDir, CustomStylesheet). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -320,18 +323,18 @@ get_verbosity(Category) -> {error,Reason} end. -loop(Mode,TestData,StartDir) -> +loop(Mode,TestData,StartDir,CustomStylesheet) -> receive {update_last_run_index,From} -> ct_logs:make_last_run_index(), return(From,ok), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {{save_suite_data,{Key,Name,Value}},From} -> ets:insert(?suite_table, #suite_data{key=Key, name=Name, value=Value}), return(From,ok), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {{read_suite_data,Key},From} -> case ets:lookup(?suite_table, Key) of [#suite_data{key=Key,name=undefined,value=Value}] -> @@ -341,7 +344,7 @@ loop(Mode,TestData,StartDir) -> _ -> return(From,undefined) end, - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {{delete_suite_data,Key},From} -> if Key == all -> ets:delete_all_objects(?suite_table); @@ -349,20 +352,20 @@ loop(Mode,TestData,StartDir) -> ets:delete(?suite_table, Key) end, return(From,ok), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {{match_delete_suite_data,KeyPat},From} -> ets:match_delete(?suite_table, #suite_data{key=KeyPat, name='_', value='_'}), return(From,ok), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {delete_testdata,From} -> return(From,ok), - loop(From,[],StartDir); + loop(From,[],StartDir,CustomStylesheet); {{delete_testdata,Key},From} -> TestData1 = lists:keydelete(Key,1,TestData), return(From,ok), - loop(From,TestData1,StartDir); + loop(From,TestData1,StartDir,CustomStylesheet); {{match_delete_testdata,{Key1,Key2}},From} -> %% handles keys with 2 elements TestData1 = @@ -380,14 +383,14 @@ loop(Mode,TestData,StartDir) -> true end, TestData), return(From,ok), - loop(From,TestData1,StartDir); + loop(From,TestData1,StartDir,CustomStylesheet); {{set_testdata,New = {Key,_Val}},From} -> TestData1 = lists:keydelete(Key,1,TestData), return(From,ok), - loop(Mode,[New|TestData1],StartDir); + loop(Mode,[New|TestData1],StartDir,CustomStylesheet); {{get_testdata, all}, From} -> return(From, TestData), - loop(From, TestData, StartDir); + loop(From, TestData, StartDir,CustomStylesheet); {{get_testdata,Key},From} -> case lists:keysearch(Key,1,TestData) of {value,{Key,Val}} -> @@ -395,7 +398,7 @@ loop(Mode,TestData,StartDir) -> _ -> return(From,undefined) end, - loop(From,TestData,StartDir); + loop(From,TestData,StartDir,CustomStylesheet); {{update_testdata,Key,Fun,Opts},From} -> TestData1 = case lists:keysearch(Key,1,TestData) of @@ -423,16 +426,16 @@ loop(Mode,TestData,StartDir) -> TestData end end, - loop(From,TestData1,StartDir); + loop(From,TestData1,StartDir,CustomStylesheet); {{set_cwd,Dir},From} -> return(From,file:set_cwd(Dir)), - loop(From,TestData,StartDir); + loop(From,TestData,StartDir,CustomStylesheet); {reset_cwd,From} -> return(From,file:set_cwd(StartDir)), - loop(From,TestData,StartDir); + loop(From,TestData,StartDir,CustomStylesheet); {get_start_dir,From} -> return(From,StartDir), - loop(From,TestData,StartDir); + loop(From,TestData,StartDir,CustomStylesheet); {{stop,Info},From} -> test_server_io:reset_state(), {MiscIoName,MiscIoDivider,MiscIoFooter} = @@ -467,7 +470,7 @@ loop(Mode,TestData,StartDir) -> test_server_io:stop([unexpected_io]), test_server_io:finish(), - ct_logs:close(Info, StartDir), + ct_logs:close(Info, StartDir, CustomStylesheet), ct_event:stop(), ct_config:stop(), ct_default_gl:stop(), @@ -475,12 +478,12 @@ loop(Mode,TestData,StartDir) -> return(From, Info); {Ref, _Msg} when is_reference(Ref) -> %% This clause is used when doing cast operations. - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {get_mode,From} -> return(From,Mode), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {'EXIT',_Pid,normal} -> - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); {'EXIT',Pid,Reason} -> case ets:lookup(?conn_table,Pid) of [#conn{address=A,callback=CB}] -> @@ -498,7 +501,7 @@ loop(Mode,TestData,StartDir) -> catch CB:close(Pid), %% in case CB:close failed to do this: unregister_connection(Pid), - loop(Mode,TestData,StartDir); + loop(Mode,TestData,StartDir,CustomStylesheet); _ -> %% Let process crash in case of error, this shouldn't happen! io:format("\n\nct_util_server got EXIT "