diff options
Diffstat (limited to 'lib/test_server/src')
| -rw-r--r-- | lib/test_server/src/erl2html2.erl | 2 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 91 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 57 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_gl.erl | 68 |
4 files changed, 159 insertions, 59 deletions
diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index 2c63103264..e69383acea 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -44,7 +44,7 @@ convert(File, Dest, InclPath) -> "<html>\n" "<head>\n" "<meta http-equiv=\"Content-Type\" content=\"text/html;" - "charset=",html_encoding(Encoding),"\"/>\n" + "charset=",html_encoding(Encoding),"\"/></meta>\n" "<title>", to_raw_list(File,Encoding), "</title>\n" "</head>\n\n" "<body bgcolor=\"white\" text=\"black\"" diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index f62eb88ccf..34acad6fd1 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -740,14 +740,10 @@ do_call_end_conf(Starter,Mod,Func,Data,TCExitReason,Conf,TVal) -> try apply(Mod,end_per_testcase,[Func,EndConf]) of _ -> ok catch - _:Why -> + _:Error -> timer:sleep(1), - GLMsg = {printout,12, - "WARNING! " - "~w:end_per_testcase(~w, ~p)" - " crashed!\n\tReason: ~p\n", - [Mod,Func,Conf,Why]}, - group_leader() ! GLMsg + print_end_conf_result(Mod,Func,Conf, + "crashed",Error) end, Supervisor ! {self(),end_conf} end, @@ -756,10 +752,7 @@ do_call_end_conf(Starter,Mod,Func,Data,TCExitReason,Conf,TVal) -> {Pid,end_conf} -> Starter ! {self(),{call_end_conf,Data,ok}}; {'EXIT',Pid,Reason} -> - group_leader() ! {printout,12, - "WARNING! ~w:end_per_testcase(~w, ~p)" - " failed!\n\tReason: ~p\n", - [Mod,Func,Conf,Reason]}, + print_end_conf_result(Mod,Func,Conf,"failed",Reason), Starter ! {self(),{call_end_conf,Data,{error,Reason}}}; {'EXIT',_OtherPid,Reason} -> %% Probably the parent - not much to do about that @@ -768,6 +761,23 @@ do_call_end_conf(Starter,Mod,Func,Data,TCExitReason,Conf,TVal) -> end, spawn_link(EndConfProc). +print_end_conf_result(Mod,Func,Conf,Cause,Error) -> + Str2Print = + fun(NoHTML) when NoHTML == stdout; NoHTML == major -> + io_lib:format("WARNING! " + "~w:end_per_testcase(~w, ~tp)" + " ~s!\n\tReason: ~tp\n", + [Mod,Func,Conf,Cause,Error]); + (minor) -> + ErrorStr = test_server_ctrl:escape_chars(Error), + io_lib:format("WARNING! " + "~w:end_per_testcase(~w, ~tp)" + " ~s!\n\tReason: ~ts\n", + [Mod,Func,Conf,Cause,ErrorStr]) + end, + group_leader() ! {printout,12,Str2Print}. + + spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid, Why,Loc,SendTo) -> FwCall = @@ -1303,7 +1313,7 @@ do_init_per_testcase(Mod, Args) -> Bad -> group_leader() ! {printout,12, "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, + "bad elements in Config: ~tp\n",[Bad]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} end; {fail,_Reason}=Res -> @@ -1321,25 +1331,33 @@ do_init_per_testcase(Mod, Args) -> throw:Other -> set_loc(erlang:get_stacktrace()), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(Line), - group_leader() ! {printout,12, - "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~ts\n\tReason: ~p\n", - [FormattedLoc, Other]}, + print_init_conf_result(Line,"thrown",Other), {skip,{failed,{Mod,init_per_testcase,Other}}}; _:Reason0 -> Stk = erlang:get_stacktrace(), Reason = {Reason0,Stk}, set_loc(Stk), Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(Line), - group_leader() ! {printout,12, - "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~ts\n\tReason: ~p\n", - [FormattedLoc,Reason]}, + print_init_conf_result(Line,"crashed",Reason), {skip,{failed,{Mod,init_per_testcase,Reason}}} end. +print_init_conf_result(Line,Cause,Reason) -> + FormattedLoc = test_server_sup:format_loc(Line), + Str2Print = + fun(NoHTML) when NoHTML == stdout; NoHTML == major -> + io_lib:format("ERROR! init_per_testcase ~s!\n" + "\tLocation: ~p\n\tReason: ~tp\n", + [Cause,Line,Reason]); + (minor) -> + ReasonStr = test_server_ctrl:escape_chars(Reason), + io_lib:format("ERROR! init_per_testcase ~s!\n" + "\tLocation: ~ts\n\tReason: ~ts\n", + [Cause,FormattedLoc,ReasonStr]) + end, + group_leader() ! {printout,12,Str2Print}. + + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1374,12 +1392,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> comment(io_lib:format("~ts<font color=\"red\">" "WARNING: ~w thrown!" "</font>\n",[Comment0,EndFunc])), - group_leader() ! {printout,12, - "WARNING: ~w thrown!\n" - "Reason: ~p\n" - "Line: ~ts\n", - [EndFunc, Other, - test_server_sup:format_loc(get_loc())]}, + print_end_tc_warning(EndFunc,Other,"thrown",get_loc()), {failed,{Mod,end_per_testcase,Other}}; Class:Reason -> Stk = erlang:get_stacktrace(), @@ -1396,15 +1409,25 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> comment(io_lib:format("~ts<font color=\"red\">" "WARNING: ~w crashed!" "</font>\n",[Comment0,EndFunc])), - group_leader() ! {printout,12, - "WARNING: ~w crashed!\n" - "Reason: ~p\n" - "Line: ~ts\n", - [EndFunc, Reason, - test_server_sup:format_loc(get_loc())]}, + print_end_tc_warning(EndFunc,Reason,"crashed",get_loc()), {failed,{Mod,end_per_testcase,Why}} end. +print_end_tc_warning(EndFunc,Reason,Cause,Loc) -> + FormattedLoc = test_server_sup:format_loc(Loc), + Str2Print = + fun(NoHTML) when NoHTML == stdout; NoHTML == major -> + io_lib:format("WARNING: ~w ~s!\n" + "Reason: ~tp\nLine: ~p\n", + [EndFunc,Cause,Reason,Loc]); + (minor) -> + ReasonStr = test_server_ctrl:escape_chars(Reason), + io_lib:format("WARNING: ~w ~s!\n" + "Reason: ~ts\nLine: ~ts\n", + [EndFunc,Cause,ReasonStr,FormattedLoc]) + end, + group_leader() ! {printout,12,Str2Print}. + get_loc() -> get(test_server_loc). diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 8a46996bc3..958fe1a2b7 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -77,7 +77,7 @@ -export([handle_call/3, handle_cast/2, handle_info/2]). -export([do_test_cases/4]). -export([do_spec/2, do_spec_list/2]). --export([xhtml/2]). +-export([xhtml/2, escape_chars/1]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3741,7 +3741,10 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, true -> ok end, - print(minor, "Config value:\n\n ~tp\n", [Args2Print]), + + print(minor, + escape_chars(io_lib:format("Config value:\n\n ~tp\n", [Args2Print])), + []), print(minor, "Current directory is ~tp\n", [Cwd]), GrNameStr = case GrName of @@ -3756,7 +3759,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>" "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>" "<td><a href=\"~ts\">~w</a></td>" - "<td><a href=\"~ts#top\"><</a> <a href=\"~ts#end\">></a></td>", + "<td><a href=\"~ts#top\"><</a> <a href=\"~ts#end\">></a></td>", [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func, EncMinorBase,EncMinorBase]), @@ -3933,7 +3936,7 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {ReportTag,Reason1}}]), - ReasonStr = reason_to_string(Reason1), + ReasonStr = escape_chars(reason_to_string(Reason1)), ReasonStr1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ReasonStr,[$\n])]), ReasonStr2 = @@ -4005,7 +4008,10 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T, [Comment]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== Location: ~ts", [FormatLoc]), - print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]), + print(minor, + escape_chars(io_lib:format("=== Reason: {testcase_aborted,~p}", + [Reason])), + []), failed; progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, @@ -4018,7 +4024,7 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; true -> "~w" end, [Time]), - ErrorReason = lists:flatten(io_lib:format("~p", [Reason])), + ErrorReason = escape_chars(lists:flatten(io_lib:format("~p", [Reason]))), ErrorReason1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ErrorReason,[$\n])]), ErrorReason2 = @@ -4041,7 +4047,9 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, [TimeStr,Comment]), print(minor, "=== Location: ~w", [unknown]), {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== Reason: " ++ FStr, [FormattedReason]), + print(minor, + escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason])), + []), failed; progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, @@ -4075,7 +4083,8 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, FormatLoc = test_server_sup:format_loc(LocMin), print(minor, "=== Location: ~ts", [FormatLoc]), {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== Reason: " ++ FStr, [FormattedReason]), + print(minor, "=== Reason: " ++ + escape_chars(io_lib:format(FStr, [FormattedReason])), []), failed; progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, @@ -4104,11 +4113,36 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, "<td><font color=\"green\">Ok</font></td>" "~ts</tr>\n", [Time,Comment]), - print(minor, "=== Returned value: ~p", [RetVal]), + print(minor, + escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])), + []), ok. %%-------------------------------------------------------------------- %% various help functions +escape_chars(Term) when not is_list(Term), not is_binary(Term) -> + esc_chars_in_list(io_lib:format("~tp", [Term])); +escape_chars(List = [Term | _]) when not is_list(Term), not is_integer(Term) -> + esc_chars_in_list(io_lib:format("~tp", [List])); +escape_chars(List) -> + esc_chars_in_list(List). + +esc_chars_in_list([Bin | Io]) when is_binary(Bin) -> + [Bin | esc_chars_in_list(Io)]; +esc_chars_in_list([List | Io]) when is_list(List) -> + [esc_chars_in_list(List) | esc_chars_in_list(Io)]; +esc_chars_in_list([$< | Io]) -> + ["<" | esc_chars_in_list(Io)]; +esc_chars_in_list([$> | Io]) -> + [">" | esc_chars_in_list(Io)]; +esc_chars_in_list([$& | Io]) -> + ["&" | esc_chars_in_list(Io)]; +esc_chars_in_list([Char | Io]) when is_integer(Char) -> + [Char | esc_chars_in_list(Io)]; +esc_chars_in_list([]) -> + []; +esc_chars_in_list(Bin) -> + Bin. get_fw_mod(Mod) -> case get(test_server_framework) of @@ -5564,8 +5598,9 @@ html_header(Title) -> "<html>\n" "<head>\n" "<title>", Title, "</title>\n" - "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n" - "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">\n" + "<meta http-equiv=\"cache-control\" content=\"no-cache\"></meta>\n" + "<meta http-equiv=\"content-type\" content=\"text/html; " + "charset=utf-8\"></meta>\n" "</head>\n" "<body bgcolor=\"white\" text=\"black\" " "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"]. diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl index c5ec3ccbe6..6abc68db54 100644 --- a/lib/test_server/src/test_server_gl.erl +++ b/lib/test_server/src/test_server_gl.erl @@ -182,7 +182,7 @@ handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> try io_req(Req, From, St) of passthrough -> group_leader() ! IoReq; - Data -> + {EscapeHtml,Data} -> case is_io_permitted(From, St) of false -> ok; @@ -193,7 +193,12 @@ handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> #st{capture=CapturePid} -> CapturePid ! {captured,Data} end, - output(minor, Data, From, From, St) + if EscapeHtml -> + output(minor, test_server_ctrl:escape_chars(Data), + From, From, St); + not EscapeHtml -> + output(minor, Data, From, From, St) + end end, From ! {io_reply,ReplyAs,ok} catch @@ -204,6 +209,13 @@ handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> handle_info({structured_io,ClientPid,{Detail,Str}}, St) -> output(Detail, Str, ClientPid, ClientPid, St), {noreply,St}; +handle_info({printout,Detail,["$tc_html",Format],Args}, St) -> + Str = io_lib:format(Format, Args), + output(Detail, ["$tc_html",Str], internal, none, St), + {noreply,St}; +handle_info({printout,Detail,Fun}, St) when is_function(Fun)-> + output(Detail, Fun, internal, none, St), + {noreply,St}; handle_info({printout,Detail,Format,Args}, St) -> Str = io_lib:format(Format, Args), output(Detail, Str, internal, none, St), @@ -231,25 +243,55 @@ do_set_props([{reject_io_reqs,Bool}|Ps], St) -> do_set_props(Ps, St#st{reject_io=Bool}); do_set_props([], St) -> St. -io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode -> - unicode:characters_to_list(Bytes, Enc); +io_req({put_chars,Enc,Str}, _, _) when Enc =:= latin1; Enc =:= unicode -> + case Str of + ["$tc_html",Str0] -> + {false,unicode:characters_to_list(Str0, Enc)}; + _ -> + {true,unicode:characters_to_list(Str, Enc)} + end; io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) -> - Str = Mod:Func(Format, Args), - unicode:characters_to_list(Str, Encoding); + case Format of + ["$tc_html",Format0] -> + Str = Mod:Func(Format0, Args), + {false,unicode:characters_to_list(Str, Encoding)}; + _ -> + Str = Mod:Func(Format, Args), + {true,unicode:characters_to_list(Str, Encoding)} + end; io_req(_, _, _) -> passthrough. -output(Level, Str, Sender, From, St) when is_integer(Level) -> +output(Level, StrOrFun, Sender, From, St) when is_integer(Level) -> case selected_by_level(Level, stdout, St) of - true -> output(stdout, Str, Sender, From, St); - false -> ok + true when hd(StrOrFun) == "$tc_html" -> + output(stdout, tl(StrOrFun), Sender, From, St); + true when is_function(StrOrFun) -> + output(stdout, StrOrFun(stdout), Sender, From, St); + true -> + output(stdout, StrOrFun, Sender, From, St); + false -> + ok end, case selected_by_level(Level, major, St) of - true -> output(major, Str, Sender, From, St); - false -> ok + true when hd(StrOrFun) == "$tc_html" -> + output(major, tl(StrOrFun), Sender, From, St); + true when is_function(StrOrFun) -> + output(major, StrOrFun(major), Sender, From, St); + true -> + output(major, StrOrFun, Sender, From, St); + false -> + ok end, case selected_by_level(Level, minor, St) of - true -> output(minor, Str, Sender, From, St); - false -> ok + true when hd(StrOrFun) == "$tc_html" -> + output(minor, tl(StrOrFun), Sender, From, St); + true when is_function(StrOrFun) -> + output(minor, StrOrFun(minor), Sender, From, St); + true -> + output(minor, test_server_ctrl:escape_chars(StrOrFun), + Sender, From, St); + false -> + ok end; output(stdout, Str, _Sender, From, St) -> output_to_file(stdout, Str, From, St); |