Merge branch 'bjorn/remove-test_server/OTP-12705'

* bjorn/remove-test_server/OTP-12705:
  Remove test_server as a standalone application
  Erlang mode for Emacs: Include ct.hrl instead test_server.hrl
  Remove out-commented references to the test_server applications
  Makefiles: Remove test_server from include path and code path
  Eliminate use of test_server.hrl and test_server_line.hrl

1 files changed, 452 insertions, 0 deletions

diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl
new file mode 100644
index 0000000000..0d881d0ada
--- /dev/null
+++ b/lib/common_test/src/test_server_io.erl
@@ -0,0 +1,452 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% This module implements a process with the registered name 'test_server_io',
+%% which has two main responsibilities:
+%%
+%%   * Manage group leader processes (see the test_server_gl module)
+%%   for test cases. A group_leader process is obtained by calling
+%%   get_gl/1. Group leader processes will be kept alive as along as
+%%   the 'test_server_io' process is alive.
+%%
+%%   * Handle output to the common log files (stdout, major, html,
+%%   unexpected_io).
+%%
+
+-module(test_server_io).
+-export([start_link/0,stop/1,get_gl/1,set_fd/2,
+	 start_transaction/0,end_transaction/0,
+	 print_buffered/1,print/3,print_unexpected/1,
+	 set_footer/1,set_job_name/1,set_gl_props/1,
+	 reset_state/0,finish/0]).
+
+-export([init/1,handle_call/3,handle_info/2,terminate/2]).
+
+-record(st, {fds,			    % Singleton fds (gb_tree)
+	     tags=[],                       % Known tag types   
+	     shared_gl :: pid(),	    % Shared group leader
+	     gls,			    % Group leaders (gb_set)
+	     io_buffering=false,	    % I/O buffering
+	     buffered,			    % Buffered I/O requests
+	     html_footer,		    % HTML footer
+	     job_name,			    % Name of current job.
+	     gl_props,			    % Properties for GL
+	     phase,                         % Indicates current mode
+	     offline_buffer,                % Buffer I/O during startup
+	     stopping,                      % Reply to when process stopped
+	     pending_ops                    % Perform when process idle 
+	    }).
+
+start_link() ->
+    case whereis(?MODULE) of
+	undefined ->
+	    case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
+		{ok,Pid} ->
+		    {ok,Pid};
+		Other ->
+		    Other
+	    end;
+	Pid ->
+	    %% already running, reset the state
+	    reset_state(),
+	    {ok,Pid}
+    end.
+
+stop(FilesToClose) ->
+    OldGL = group_leader(),
+    group_leader(self(), self()),
+    req({stop,FilesToClose}),
+    group_leader(OldGL, self()),
+    ok.
+
+finish() ->
+    req(finish).
+
+%% get_gl(Shared) -> Pid
+%%  Shared = boolean()
+%%  Pid = pid()
+%%
+%%  Return a group leader (a process using the test_server_gl module).
+%%  If Shared is true, the shared group leader is returned (suitable for
+%%  running sequential test cases), otherwise a new group leader process
+%%  is spawned. Group leader processes will live until the
+%%  'test_server_io' process is stopped.
+
+get_gl(Shared) when is_boolean(Shared) ->
+    req({get_gl,Shared}).
+
+%% set_fd(Tag, Fd) -> ok.
+%%  Tag = major | html | unexpected_io
+%%  Fd = a file descriptor (as returned by file:open/2)
+%%
+%%  Associate a file descriptor with the given Tag. This
+%%  Tag can later be used in when calling to print/3.
+
+set_fd(Tag, Fd) ->
+    req({set_fd,Tag,Fd}).
+
+%% start_transaction()
+%%
+%%  Subsequent calls to print/3 from the process executing start_transaction/0
+%%  will cause the messages to be buffered instead of printed directly.
+
+start_transaction() ->
+    req({start_transaction,self()}).
+
+%% end_transaction()
+%%
+%%  End the transaction started by start_transaction/0. Subsequent calls to
+%%  print/3 will cause the message to be printed directly.
+
+end_transaction() ->
+    req({end_transaction,self()}).
+
+%% print(From, Tag, Msg)
+%%  From = pid()
+%%  Tag = stdout, or any tag that has been registered using set_fd/2
+%%  Msg = string or iolist
+%%
+%%  Either print Msg to the file identified by Tag, or buffer the message
+%%  start_transaction/0 has been called from the process From.
+%%
+%%  NOTE: The tags have various special meanings. For example, 'html'
+%%  is assumed to be a HTML file.
+
+print(From, Tag, Msg) ->
+    req({print,From,Tag,Msg}).
+
+%% print_buffered(Pid)
+%%  Pid = pid()
+%%
+%%  Print all messages buffered in the *first* transaction buffered for Pid.
+%%  (If start_transaction/0 and end_transaction/0 has been called N times,
+%%  print_buffered/1 must be called N times to print all transactions.)
+
+print_buffered(Pid) ->
+    req({print_buffered,Pid}).
+
+%% print_unexpected(Msg)
+%%  Msg = string or iolist
+%%
+%%  Print the given string in the unexpected_io log.
+
+print_unexpected(Msg) ->
+    print(xxxFrom,unexpected_io,Msg).
+
+%% set_footer(IoData)
+%%
+%%  Set a footer for the file associated with the 'html' tag.
+%%  It will be used by print/3 to print a footer for the HTML file.
+
+set_footer(Footer) ->
+    req({set_footer,Footer}).
+
+%% set_job_name(Name)
+%%
+%%  Set a name for the currently running job. The name will be used
+%%  when printing to 'stdout'.
+%%
+
+set_job_name(Name) ->
+    req({set_job_name,Name}).
+
+%% set_gl_props(PropList)
+%%
+%%  Set properties for group leader processes. When a group_leader process
+%%  is created, test_server_gl:set_props(PropList) will be called.
+
+set_gl_props(PropList) ->
+    req({set_gl_props,PropList}).
+
+%% reset_state
+%%
+%% Reset the initial state
+reset_state() ->
+    req(reset_state).
+
+%%% Internal functions.
+
+init([]) ->
+    process_flag(trap_exit, true),
+    Empty = gb_trees:empty(),
+    {ok,Shared} = test_server_gl:start_link(),
+    {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
+	    io_buffering=gb_sets:empty(),
+	    buffered=Empty,
+	    html_footer="</body>\n</html>\n",
+	    job_name="<name not set>",
+	    gl_props=[],
+	    phase=starting,
+	    offline_buffer=[],
+	    pending_ops=[]}}.
+
+req(Req) ->
+    gen_server:call(?MODULE, Req, infinity).
+
+handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) ->
+    {ok,Pid} = test_server_gl:start_link(),
+    test_server_gl:set_props(Pid, Props),
+    {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}};
+handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) ->
+    {reply,Shared,St};
+handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0,tags=Tags0,
+					offline_buffer=OfflineBuff}=St) ->
+    Fds = gb_trees:enter(Tag, Fd, Fds0),
+    St1 = St#st{fds=Fds,tags=[Tag|lists:delete(Tag, Tags0)]},
+    OfflineBuff1 =
+	if OfflineBuff == [] ->
+		[];
+	   true ->
+		%% Fd ready, print anything buffered for associated Tag
+		lists:filtermap(fun({T,From,Str}) when T == Tag ->
+					output(From, Tag, Str, St1),
+					false;
+				   (_) ->
+					true
+				end, lists:reverse(OfflineBuff))
+	end,
+    {reply,ok,St1#st{phase=started,
+		     offline_buffer=lists:reverse(OfflineBuff1)}};
+handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+						buffered=Buf0}=St) ->
+    Buf = case gb_trees:is_defined(Pid, Buf0) of
+	      false -> gb_trees:insert(Pid, queue:new(), Buf0);
+	      true -> Buf0
+	  end,
+    Buffer = gb_sets:add(Pid, Buffer0),
+    {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}};
+handle_call({print,From,Tag,Str}, _From, St0) ->
+    St = output(From, Tag, Str, St0),
+    {reply,ok,St};
+handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+					      buffered=Buffered0}=St0) ->
+    Q0 = gb_trees:get(Pid, Buffered0),
+    Q = queue:in(eot, Q0),
+    Buffered = gb_trees:update(Pid, Q, Buffered0),
+    Buffer = gb_sets:delete_any(Pid, Buffer0),
+    St = St0#st{io_buffering=Buffer,buffered=Buffered},
+    {reply,ok,St};
+handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) ->
+    Q0 = gb_trees:get(Pid, Buffered0),
+    Q = do_print_buffered(Q0, St0),
+    Buffered = gb_trees:update(Pid, Q, Buffered0),
+    St = St0#st{buffered=Buffered},
+    {reply,ok,St};
+handle_call({set_footer,Footer}, _From, St) ->
+    {reply,ok,St#st{html_footer=Footer}};
+handle_call({set_job_name,Name}, _From, St) ->
+    {reply,ok,St#st{job_name=Name}};
+handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) ->
+    test_server_gl:set_props(Shared, Props),
+    {reply,ok,St#st{gl_props=Props}};
+handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) ->
+    %% can't reset during stopping phase, save op for later
+    Op = fun(NewSt) -> 
+		 {_,Result,NewSt1} = handle_call(reset_state, From, NewSt),
+		 {Result,NewSt1}
+	 end,
+    {noreply,St#st{pending_ops=[{From,Op}|Ops]}};
+handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls,
+				    offline_buffer=OfflineBuff}) ->
+    %% close open log files
+    lists:foreach(fun(Tag) ->
+			  case gb_trees:lookup(Tag, Fds) of
+			      none ->
+				  ok;
+			      {value,Fd} ->
+				  file:close(Fd)
+			  end
+		  end, Tags),
+    GlList = gb_sets:to_list(Gls),
+    [test_server_gl:stop(GL) || GL <- GlList],
+    timer:sleep(100),
+    case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlList) of
+	[] ->
+	    ok;
+	_ ->
+	    timer:sleep(2000),
+	    [exit(GL, kill) || GL <- GlList]
+    end,
+    Empty = gb_trees:empty(),
+    {ok,Shared} = test_server_gl:start_link(),
+    {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
+		  io_buffering=gb_sets:empty(),
+		  buffered=Empty,
+		  html_footer="</body>\n</html>\n",
+		  job_name="<name not set>",
+		  gl_props=[],
+		  phase=starting,
+		  offline_buffer=OfflineBuff,
+		  pending_ops=[]}};
+handle_call({stop,FdTags}, From, #st{fds=Fds0,tags=Tags0,
+				     shared_gl=SGL,gls=Gls0}=St0) ->
+    St = St0#st{gls=gb_sets:insert(SGL, Gls0),phase=stopping,stopping=From},
+    gc(St),
+    %% close open log files
+    {Fds1,Tags1} = lists:foldl(fun(Tag, {Fds,Tags}) ->
+			       case gb_trees:lookup(Tag, Fds) of
+				   none ->
+				       {Fds,Tags};
+				   {value,Fd} ->
+				       file:close(Fd),
+				       {gb_trees:delete(Tag, Fds),
+					lists:delete(Tag, Tags)}
+			       end
+		       end, {Fds0,Tags0}, FdTags),
+    %% Give the users of the surviving group leaders some
+    %% time to finish.
+    erlang:send_after(1000, self(), stop_group_leaders),    
+    {noreply,St#st{fds=Fds1,tags=Tags1}};
+handle_call(finish, From, St) ->
+    gen_server:reply(From, ok),
+    {stop,normal,St}.
+
+handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
+    Gls = gb_sets:delete_any(Pid, Gls0),
+    case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
+	true ->
+	    %% No more group leaders left.
+	    gen_server:reply(From, ok),
+	    {noreply,St#st{gls=Gls,phase=stopping,stopping=undefined}};
+	false ->
+	    %% Wait for more group leaders to finish.
+	    {noreply,St#st{gls=Gls,phase=stopping}}
+    end;
+handle_info({'EXIT',_Pid,Reason}, _St) ->
+    exit(Reason);
+handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
+    %% Stop the remaining group leaders.
+    GlPids = gb_sets:to_list(Gls),
+    [test_server_gl:stop(GL) || GL <- GlPids],
+    timer:sleep(100),
+    Wait = 
+	case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlPids) of
+	    [] -> 0;
+	    _  -> 2000
+	end,
+    erlang:send_after(Wait, self(), kill_group_leaders),
+    {noreply,St};
+handle_info(kill_group_leaders, #st{gls=Gls,stopping=From,
+				    pending_ops=Ops}=St) ->
+    [exit(GL, kill) || GL <- gb_sets:to_list(Gls)],
+    if From /= undefined ->
+	    gen_server:reply(From, ok);
+       true ->					% reply has been sent already
+	    ok
+    end,
+    %% we're idle, check if any ops are pending
+    St1 = lists:foldr(fun({ReplyTo,Op},NewSt) ->
+			      {Result,NewSt1} = Op(NewSt),
+			      gen_server:reply(ReplyTo, Result),
+			      NewSt1
+		      end, St#st{phase=idle,pending_ops=[]}, Ops),
+    {noreply,St1};
+handle_info(Other, St) ->
+    io:format("Ignoring: ~p\n", [Other]),
+    {noreply,St}.
+
+terminate(_, _) ->
+    ok.
+
+output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0,
+			   phase=Phase,offline_buffer=OfflineBuff}=St) ->
+    case gb_sets:is_member(From, Buffered) of
+	false ->
+	    case do_output(Tag, Str, Phase, St) of
+		buffer when length(OfflineBuff)>500 ->
+		    %% something's wrong, clear buffer
+		    St#st{offline_buffer=[]};
+		buffer ->
+		    St#st{offline_buffer=[{Tag,From,Str}|OfflineBuff]};
+		_ ->
+		    St
+	    end;
+	true ->
+	    Q0 = gb_trees:get(From, Buf0),
+	    Q = queue:in({Tag,Str}, Q0),
+	    Buf = gb_trees:update(From, Q, Buf0),
+	    St#st{buffered=Buf}
+    end.
+
+do_output(stdout, Str, _, #st{job_name=undefined}) ->
+    io:put_chars(Str);
+do_output(stdout, Str0, _, #st{job_name=Name}) ->
+    Str = io_lib:format("Testing ~ts: ~ts\n", [Name,Str0]),
+    io:put_chars(Str);
+do_output(Tag, Str, Phase, #st{fds=Fds}=St) ->
+    case gb_trees:lookup(Tag, Fds) of
+	none when Phase /= started ->
+	    buffer;
+	none ->
+	    S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n",
+			      [?MODULE,?LINE,Tag]),
+	    do_output(stdout, [S,Str], Phase, St);
+	{value,Fd} ->
+	    try
+		io:put_chars(Fd, Str),
+		case Tag of
+		    html -> finalise_table(Fd, St);
+		    _ -> ok
+		end
+	    catch _:Error ->
+		    S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to "
+				      "log file '~p': ~p\n",
+				      [?MODULE,?LINE,Tag,Error]),
+		    do_output(stdout, [S,Str], Phase, St)
+	    end
+    end.
+
+finalise_table(Fd, #st{html_footer=Footer}) ->
+    case file:position(Fd, {cur,0}) of
+	{ok,Pos} ->
+	    %% We are writing to a seekable file. Finalise so
+	    %% we get complete valid (and viewable) HTML code.
+	    %% Then rewind to overwrite the finalising code.
+	    io:put_chars(Fd, ["\n</table>\n",Footer]),
+	    file:position(Fd, Pos);
+	{error,epipe} ->
+	    %% The file is not seekable.  We cannot erase what
+	    %% we've already written --- so the reader will
+	    %% have to wait until we're done.
+	    ok
+    end.
+
+do_print_buffered(Q0, St) ->
+    Item = queue:get(Q0),
+    Q = queue:drop(Q0),
+    case Item of
+	eot ->
+	    Q;
+	{Tag,Str} ->
+	    do_output(Tag, Str, undefined, St),
+	    do_print_buffered(Q, St)
+    end.
+
+gc(#st{gls=Gls0}) ->
+    InUse0 = [begin
+		  case process_info(P, group_leader) of
+		      {group_leader,GL} -> GL;
+		      undefined -> undefined
+		  end
+	      end || P <- processes()],
+    InUse = ordsets:from_list(InUse0),
+    Gls = gb_sets:to_list(Gls0),
+    NotUsed = ordsets:subtract(Gls, InUse),
+    [test_server_gl:stop(Pid) || Pid <- NotUsed],
+    ok.