aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server')
-rw-r--r--lib/test_server/src/erl2html2.erl2
-rw-r--r--lib/test_server/src/test_server.erl91
-rw-r--r--lib/test_server/src/test_server_ctrl.erl57
-rw-r--r--lib/test_server/src/test_server_gl.erl68
-rw-r--r--lib/test_server/test/erl2html2_SUITE.erl2
5 files changed, 160 insertions, 60 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\">&lt;</a> <a href=\"~ts#end\">&gt;</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]) ->
+ ["&lt;" | esc_chars_in_list(Io)];
+esc_chars_in_list([$> | Io]) ->
+ ["&gt;" | esc_chars_in_list(Io)];
+esc_chars_in_list([$& | Io]) ->
+ ["&amp;" | 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);
diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/test_server/test/erl2html2_SUITE.erl
index 9e6389109b..8e9f6e773a 100644
--- a/lib/test_server/test/erl2html2_SUITE.erl
+++ b/lib/test_server/test/erl2html2_SUITE.erl
@@ -31,7 +31,7 @@
"<html>\n",
"<head><title>Module ", Src, "</title>\n",
"<meta http-equiv=\"cache-control\" ",
- "content=\"no-cache\">\n",
+ "content=\"no-cache\"></meta>\n",
"</head>\n",
"<body bgcolor=\"white\" text=\"black\" ",
"link=\"blue\" vlink=\"purple\" alink=\"red\">\n"]).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-17 22:02:35 +0000