path: root/lib/common_test/src/ct_framework.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%

%%% @doc Common Test Framework callback module.
%%%
%%% <p>This module exports framework callback functions which are
%%% called from the test_server.</p>

-module(ct_framework).

-export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
-export([error_notification/4]).

-export([overview_html_header/1]).

-export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]).

-export([make_all_conf/3, make_conf/5]).

-include("ct_event.hrl").
-include("ct_util.hrl").

%%%-----------------------------------------------------------------
%%% @spec init_tc(Mod,Func,Args) -> {ok,NewArgs} | {error,Reason} |
%%%         {skip,Reason} | {auto_skip,Reason}
%%%      Mod = atom()
%%%      Func = atom()
%%%      Args = list()
%%%      NewArgs = list()
%%%      Reason = term()
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a new test case is started.
init_tc(Mod,Func,Config) ->
    %% check if previous testcase was interpreted and has left
    %% a "dead" trace window behind - if so, kill it
    case ct_util:get_testdata(interpret) of
	{What,kill,{TCPid,AttPid}} ->
	    ct_util:kill_attached(TCPid,AttPid),
	    ct_util:set_testdata({interpret,{What,kill,{undefined,undefined}}});
	_ ->
	    ok
    end,
	    
    %% check if we need to add defaults explicitly because
    %% there's no init_per_suite exported from Mod
    {InitFailed,DoInit} =
	case ct_util:get_testdata(curr_tc) of
	    {Mod,{suite0_failed,_}=Failure} ->
		{Failure,false};
	    {Mod,_} ->
		{false,false};
	    _ when Func == init_per_suite ->
		{false,false};
	    _ ->
		{false,true}
	end,
    case InitFailed of
	false ->
	    ct_util:set_testdata({curr_tc,{Mod,Func}}),
	    case ct_util:read_suite_data({seq,Mod,Func}) of
		undefined ->
		    init_tc1(Mod,Func,Config,DoInit);
		Seq when is_atom(Seq) ->
		    case ct_util:read_suite_data({seq,Mod,Seq}) of
			[Func|TCs] ->		% this is the 1st case in Seq
			    %% make sure no cases in this seq are marked as failed
			    %% from an earlier execution in the same suite
			    lists:foreach(fun(TC) ->
						  ct_util:save_suite_data({seq,Mod,TC},Seq)
					  end, TCs);
			_ ->
			    ok
		    end,
		    init_tc1(Mod,Func,Config,DoInit);
		{failed,Seq,BadFunc} ->
		    {skip,{sequence_failed,Seq,BadFunc}}
	    end;
	{_,{require,Reason}} ->
	    {skip,{require_failed_in_suite0,Reason}};
	_ ->
	    {skip,InitFailed}
    end.	    

init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) ->
    Config1 = 
	case ct_util:read_suite_data(last_saved_config) of
	    {{Mod,LastFunc},SavedConfig} ->	% last testcase
		[{saved_config,{LastFunc,SavedConfig}} | 
		 lists:keydelete(saved_config,1,Config0)];
	    {{LastSuite,InitOrEnd},SavedConfig} when InitOrEnd == init_per_suite ;
						     InitOrEnd == end_per_suite ->
		%% last suite
		[{saved_config,{LastSuite,SavedConfig}} | 
		 lists:keydelete(saved_config,1,Config0)];
	    undefined ->
		lists:keydelete(saved_config,1,Config0)
	end,
    ct_util:delete_suite_data(last_saved_config),
    Config = lists:keydelete(watchdog,1,Config1),
    if Func /= init_per_suite, DoInit /= true ->
	    ok;
	true ->
	    %% delete all default values used in previous suite
	    ct_config:delete_default_config(suite),
	    %% release all name -> key bindings (once per suite)
	    ct_config:release_allocated()
    end,
    TestCaseInfo =
	case catch apply(Mod,Func,[]) of
	    Result when is_list(Result) -> Result;
	    _ -> []
	end,
    %% clear all config data default values set by previous
    %% testcase info function (these should only survive the
    %% testcase, not the whole suite)
    ct_config:delete_default_config(testcase),
    case add_defaults(Mod,Func,TestCaseInfo,DoInit) of
	Error = {suite0_failed,_} ->
	    ct_logs:init_tc(),
	    FuncSpec = group_or_func(Func,Config0),
	    ct_event:notify(#event{name=tc_start,
				   node=node(),
				   data={Mod,FuncSpec}}),
	    ct_util:set_testdata({curr_tc,{Mod,Error}}),
	    {error,Error};
	{SuiteInfo,MergeResult} ->
	    case MergeResult of
		{error,Reason} when DoInit == false ->
		    ct_logs:init_tc(),
		    FuncSpec = group_or_func(Func,Config0),
		    ct_event:notify(#event{name=tc_start,
					   node=node(),
					   data={Mod,FuncSpec}}),
		    {skip,Reason};
		_ ->
		    init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit)
	    end
    end;
init_tc1(_Mod,_Func,Args,_DoInit) ->
    {ok,Args}.

init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) ->
    %% if first testcase fails when there's no init_per_suite
    %% we must do suite/0 configurations before skipping test
    MergedInfo =
	case MergeResult of
	    {error,_} when DoInit == true ->
		SuiteInfo;
	    _ ->
		MergeResult
	end,

    %% timetrap must be handled before require
    MergedInfo1 = timetrap_first(MergedInfo, [], []),
    %% tell logger to use specified style sheet
    case lists:keysearch(stylesheet,1,MergedInfo++Config) of
	{value,{stylesheet,SSFile}} ->
	    ct_logs:set_stylesheet(Func,add_data_dir(SSFile,Config));
	_ ->
	    case ct_util:get_testdata(stylesheet) of
		undefined ->
		    ct_logs:clear_stylesheet(Func);
		SSFile ->
		    ct_logs:set_stylesheet(Func,SSFile)
	    end
    end,
    %% suppress output for connections (Conns is a 
    %% list of {Type,Bool} tuples, e.g. {telnet,true}),		
    case ct_util:get_overridden_silenced_connections() of
	undefined ->
	    case lists:keysearch(silent_connections,1,MergedInfo++Config) of
		{value,{silent_connections,Conns}} ->
		    ct_util:silence_connections(Conns);
		_ ->
		    ok
	    end;
	Conns ->
	    ct_util:silence_connections(Conns)
    end,
    
    ct_logs:init_tc(),
    FuncSpec = group_or_func(Func,Config),
    ct_event:notify(#event{name=tc_start,
			   node=node(),
			   data={Mod,FuncSpec}}),
    
    case configure(MergedInfo1,MergedInfo1,SuiteInfo,{Func,DoInit},Config) of
	{suite0_failed,Reason} ->
	    ct_util:set_testdata({curr_tc,{Mod,{suite0_failed,{require,Reason}}}}),
	    {skip,{require_failed_in_suite0,Reason}};
	{error,Reason} ->
	    {auto_skip,{require_failed,Reason}};
	{ok, FinalConfig} ->
	    case MergeResult of
		{error,Reason} ->
		    %% suite0 configure finished now, report that 
		    %% first test case actually failed		    
		    {skip,Reason};
		_ ->
		    case get('$test_server_framework_test') of
			undefined ->
			    ct_suite_init(Mod, FuncSpec, FinalConfig);
			Fun ->
			    case Fun(init_tc, FinalConfig) of
				NewConfig when is_list(NewConfig) ->
				    {ok,NewConfig};
				Else ->
				    Else
			    end
		    end
	    end
    end.

ct_suite_init(Mod, Func, [Config]) when is_list(Config) ->
    case ct_suite_callback:init_tc( Mod, Func, Config) of
	NewConfig when is_list(NewConfig) ->
	    {ok, [NewConfig]};
	Else ->
	    Else
    end.

add_defaults(Mod,Func,FuncInfo,DoInit) ->
    case (catch Mod:suite()) of
	{'EXIT',{undef,_}} ->
	    SuiteInfo = merge_with_suite_defaults(Mod,[]),
	    case add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) of
		Error = {error,_} -> {SuiteInfo,Error};
		MergedInfo -> {SuiteInfo,MergedInfo}
	    end;
	{'EXIT',Reason} -> 
	    {suite0_failed,{exited,Reason}};
	SuiteInfo when is_list(SuiteInfo) ->
	    case lists:all(fun(E) when is_tuple(E) -> true;
			      (_) -> false
			   end, SuiteInfo) of
		true ->
		    SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo),
		    case add_defaults1(Mod,Func,FuncInfo,SuiteInfo1,DoInit) of
			Error = {error,_} -> {SuiteInfo1,Error};
			MergedInfo -> {SuiteInfo1,MergedInfo}
		    end;
		false ->
		    {suite0_failed,bad_return_value}
	    end;
	_ ->
	    {suite0_failed,bad_return_value}
    end.

add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_DoInit) ->
    SuiteInfo;

add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) ->
    %% mustn't re-require suite variables in test case info function,
    %% can result in weird behaviour (suite values get overwritten)
    SuiteReqs = 
	[SDDef || SDDef <- SuiteInfo,
		  ((require == element(1,SDDef)) or
		   (default_config == element(1,SDDef)))],
    FuncReqs =
	[FIDef || FIDef <- FuncInfo,
		  require == element(1,FIDef)],
    case [element(2,Clash) || Clash <- SuiteReqs,
			      require == element(1, Clash),
			      true == lists:keymember(element(2,Clash),2,
						      FuncReqs)] of
	[] ->
	    add_defaults2(Mod,Func,FuncInfo,SuiteInfo,SuiteReqs,DoInit);
	Clashes ->
	    {error,{config_name_already_in_use,Clashes}}
    end.

add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,false) ->
    %% not common practise to use a test case info function for
    %% init_per_suite (usually handled by suite/0), but let's support
    %% it just in case...
    add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,true);

add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,_,false) ->
    %% include require elements from test case info, but not from suite/0
    %% (since we've already required those vars)
    FuncInfo ++
	[SFDef || SFDef <- SuiteInfo,
		  require /= element(1,SFDef),
		  false == lists:keymember(element(1,SFDef),1,FuncInfo)];

add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,SuiteReqs,true) ->
    %% We must include require elements from suite/0 here since
    %% there's no init_per_suite call before this first test case.
    %% Let other test case info elements override those from suite/0.
    FuncInfo ++ SuiteReqs ++
	[SDDef || SDDef <- SuiteInfo,
		  require /= element(1,SDDef),
		  false == lists:keymember(element(1,SDDef),1,FuncInfo)].    

merge_with_suite_defaults(Mod,SuiteInfo) ->
    case lists:keysearch(suite_defaults,1,Mod:module_info(attributes)) of
	{value,{suite_defaults,Defaults}} ->
	    SDReqs =
		[SDDef || SDDef <- Defaults,
			  require == element(1,SDDef),
			  false == lists:keymember(element(2,SDDef),2,
						   SuiteInfo)],
	    SuiteInfo ++ SDReqs ++
		[SDDef || SDDef <- Defaults,
			  require /= element(1,SDDef),
			  false == lists:keymember(element(1,SDDef),1,
						   SuiteInfo)];		    
	false ->
	    SuiteInfo
    end.

timetrap_first([Trap = {timetrap,_} | Rest],Info,Found) ->
    timetrap_first(Rest,Info,[Trap | Found]);
timetrap_first([Other | Rest],Info,Found) ->
    timetrap_first(Rest,[Other | Info],Found);
timetrap_first([],Info,[]) ->
    [{timetrap,{minutes,30}} | lists:reverse(Info)];
timetrap_first([],Info,Found) ->
    lists:reverse(Found) ++ lists:reverse(Info).

configure([{require,Required}|Rest],Info,SuiteInfo,Scope,Config) ->
    case ct:require(Required) of
	ok ->
	    configure(Rest,Info,SuiteInfo,Scope,Config);
	Error = {error,Reason} ->
	    case required_default('_UNDEF',Required,Info,SuiteInfo,Scope) of
		ok ->
		    configure(Rest,Info,SuiteInfo,Scope,Config);
		_ ->
		    case lists:keymember(Required,2,SuiteInfo) of
			true ->
			    {suite0_failed,Reason};
			false ->
			    Error
		    end
	    end
    end;
configure([{require,Name,Required}|Rest],Info,SuiteInfo,Scope,Config) ->
    case ct:require(Name,Required) of
	ok ->
	    configure(Rest,Info,SuiteInfo,Scope,Config);
	Error = {error,Reason} ->
	    case required_default(Name,Required,Info,SuiteInfo,Scope) of
		ok ->
		    configure(Rest,Info,SuiteInfo,Scope,Config);
		_ ->
		    case lists:keymember(Name,2,SuiteInfo) of
			true -> 
			    {suite0_failed,Reason};
			false ->
			    Error
		    end
	    end
    end;
configure([{timetrap,off}|Rest],Info,SuiteInfo,Scope,Config) ->
    configure(Rest,Info,SuiteInfo,Scope,Config);
configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,Config) ->
    Dog = test_server:timetrap(Time),
    configure(Rest,Info,SuiteInfo,Scope,[{watchdog,Dog}|Config]);
configure([{suite_callbacks, CB} | Rest], Info, SuiteInfo, Scope, Config) ->
    configure(Rest, Info, SuiteInfo, Scope, [{suite_callbacks, CB} | Config]);
configure([_|Rest],Info,SuiteInfo,Scope,Config) ->
    configure(Rest,Info,SuiteInfo,Scope,Config);
configure([],_,_,_,Config) ->
    {ok,[Config]}.

%% the require element in Info may come from suite/0 and
%% should be scoped 'suite', or come from the testcase info
%% function and should then be scoped 'testcase'
required_default(Name,Key,Info,SuiteInfo,{Func,true}) ->
    case try_set_default(Name,Key,SuiteInfo,suite) of
	ok ->
	    ok;
	_ ->
	    required_default(Name,Key,Info,[],{Func,false})
    end;
required_default(Name,Key,Info,_,{init_per_suite,_}) ->
    try_set_default(Name,Key,Info,suite);
required_default(Name,Key,Info,_,_) ->
    try_set_default(Name,Key,Info,testcase).

try_set_default(Name,Key,Info,Where) ->
    CfgElems = 
	case lists:keysearch(Name,1,Info) of
	    {value,{Name,Val}} ->
		[Val];
	    false ->
		case catch [{Key,element(3,Elem)} || Elem <- Info,
						     element(1,Elem)==default_config,
						     element(2,Elem)==Key] of
		    {'EXIT',_} -> [];
		    Result -> Result
		end
	end,
    case {Name,CfgElems} of
	{_,[]} -> 
	    no_default;
	{'_UNDEF',_} ->
	    [ct_config:set_default_config([CfgVal],Where) || CfgVal <- CfgElems],
	    ok;
	_ ->
	    [ct_config:set_default_config(Name,[CfgVal],Where) || CfgVal <- CfgElems],
	    ok
    end.
	    

%%%-----------------------------------------------------------------
%%% @spec end_tc(Mod,Func,Args) -> {ok,NewArgs}| {error,Reason} |
%%%         {skip,Reason} | {auto_skip,Reason}
%%%      Mod = atom()
%%%      Func = atom()
%%%      Args = list()
%%%      NewArgs = list()
%%%      Reason = term()
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a test case is finished.
end_tc(?MODULE,error_in_suite,_, _) ->		% bad start!
    ok;
end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) ->
    end_tc(Mod,Func,TCPid,Result,Args,Return);
end_tc(Mod,Func,{Result,[Args]}, Return) ->
    end_tc(Mod,Func,self(),Result,Args,Return).

end_tc(Mod,Func,TCPid,Result,Args,Return) ->
    case lists:keysearch(watchdog,1,Args) of
	{value,{watchdog,Dog}} -> test_server:timetrap_cancel(Dog);
	false -> ok
    end,

    %% save the testcase process pid so that it can be used
    %% to look up the attached trace window later
    case ct_util:get_testdata(interpret) of
	{What,kill,_} ->
	    AttPid = ct_util:get_attached(self()),
	    ct_util:set_testdata({interpret,{What,kill,{self(),AttPid}}});
	_ ->
	    ok
    end,

    ct_util:delete_testdata(comment),
    ct_util:delete_suite_data(last_saved_config),
    FuncSpec =
	case group_or_func(Func,Args) of
	    {_,GroupName,_Props} = Group ->			       
		case lists:keysearch(save_config,1,Args) of
		    {value,{save_config,SaveConfig}} ->
			ct_util:save_suite_data(
			  last_saved_config,
			  {Mod,{group,GroupName}},
			  SaveConfig),
			Group;
		    false ->
			Group
		end;
	    _ ->
		case lists:keysearch(save_config,1,Args) of
		    {value,{save_config,SaveConfig}} ->
			ct_util:save_suite_data(last_saved_config,
						{Mod,Func},SaveConfig),
			Func;
		    false ->
			Func
		end
	end,
    ct_util:reset_silent_connections(),

    %% send sync notification so that event handlers may print
    %% in the log file before it gets closed
    ct_event:sync_notify(#event{name=tc_done,
				node=node(),
				data={Mod,FuncSpec,tag(Result)}}),
    case Result of
	{skip,{sequence_failed,_,_}} ->
	    %% ct_logs:init_tc is never called for a skipped test case
	    %% in a failing sequence, so neither should end_tc	    
	    ok;
	_ ->
	    case ct_logs:end_tc(TCPid) of
		{error,Reason} ->
		    exit({error,{logger,Reason}});
		_ ->
		    ok
	    end
    end,
    case Func of
	end_per_suite -> 
	    ct_util:match_delete_suite_data({seq,Mod,'_'});
	_ -> 
	    ok
    end,
    case get('$test_server_framework_test') of
	undefined ->
	    ct_suite_callback:end_tc(
	      Mod, FuncSpec, Args, Return);
	Fun ->
	    Fun(end_tc, ok)
    end.

%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | 
%% {testcase_aborted,Reason} | testcase_aborted_or_killed | 
%% {'EXIT',Reason} | Other (ignored return value, e.g. 'ok')
tag({STag,Reason}) when STag == skip; STag == skipped -> 
    {skipped,Reason};
tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; 
                       ETag == timetrap_timeout;
                       ETag == testcase_aborted -> 
    {failed,E};
tag(E = testcase_aborted_or_killed) ->
    {failed,E};
tag(Other) ->
    Other.

%%%-----------------------------------------------------------------
%%% @spec error_notification(Mod,Func,Args,Error) -> ok
%%%      Mod = atom()
%%%      Func = atom()
%%%      Args = list()
%%%      Error = term()
%%%
%%% @doc This function is called as the result of testcase 
%%% <code>Func</code> in suite <code>Mod</code> crashing. 
%%% <code>Error</code> specifies the reason for failing.
error_notification(Mod,Func,_Args,{Error,Loc}) ->
    ErrSpec = case Error of
		 {What={_E,_R},Trace} when is_list(Trace) ->
		      What;
		  What ->
		      What
	      end,
    ErrStr = case ErrSpec of
		 {badmatch,Descr} ->
		     Descr1 = lists:flatten(io_lib:format("~P",[Descr,10])),
		     if length(Descr1) > 50 ->
			     Descr2 = string:substr(Descr1,1,50),
			     io_lib:format("{badmatch,~s...}",[Descr2]);
			true ->
			     io_lib:format("{badmatch,~s}",[Descr1])
		     end;
		 {test_case_failed,Reason} ->
		     case (catch io_lib:format("{test_case_failed,~s}", [Reason])) of
			 {'EXIT',_} ->
			     io_lib:format("{test_case_failed,~p}", [Reason]);
			 Result -> Result
		     end;
		 {Spec,_Reason} when is_atom(Spec) ->
		     io_lib:format("~w", [Spec]);
		 Other ->
		     io_lib:format("~P", [Other,5])
	     end,
    ErrorHtml = "<font color=\"brown\">" ++ ErrStr ++ "</font>",
    case {Mod,Error} of
	%% some notifications come from the main test_server process
	%% and for these cases the existing comment may not be modified
	{_,{timetrap_timeout,_TVal}} ->
	    ok;
	{_,{testcase_aborted,_Info}} ->
	    ok;
	{_,testcase_aborted_or_killed} ->
	    ok;
	{undefined,_OtherError} ->
	    ok;
	_ ->			     
	    %% this notification comes from the test case process, so
	    %% we can add error info to comment with test_server:comment/1
	    case ct_util:get_testdata(comment) of
		undefined ->
		    test_server:comment(ErrorHtml);
		Comment ->
		    CommentHtml = 
			"<font color=\"green\">" ++ "(" ++ "</font>"
			++ Comment ++ 
			"<font color=\"green\">" ++ ")" ++ "</font>",
		    Str = io_lib:format("~s   ~s", [ErrorHtml,CommentHtml]),
		    test_server:comment(Str)
	    end
    end,

    io:format(user, "~n- - - - - - - - - - - - - - - - "
	      "- - - - - - - - - -~n", []),
    case Loc of
	%% we don't use the line parse transform as we compile this 
	%% module so location will be on form {M,F}
	[{?MODULE,error_in_suite}] ->
	    io:format(user, "Error in suite detected: ~s", [ErrStr]);

	unknown ->
	    io:format(user, "Error detected: ~s", [ErrStr]);

	%% if a function specified by all/0 does not exist, we
	%% pick up undef here
	[{LastMod,LastFunc}] ->
	    io:format(user, "~w:~w could not be executed~n", 
		      [LastMod,LastFunc]),
	    io:format(user, "Reason: ~s", [ErrStr]);
	    
	[{LastMod,LastFunc,LastLine}|_] ->
	    %% print error to console, we are only
	    %% interested in the last executed expression
	    io:format(user, "~w:~w failed on line ~w~n", 
		      [LastMod,LastFunc,LastLine]),
	    io:format(user, "Reason: ~s", [ErrStr]),
    
	    case ct_util:read_suite_data({seq,Mod,Func}) of
		undefined ->
		    ok;
		Seq ->
		    SeqTCs = ct_util:read_suite_data({seq,Mod,Seq}),
		    mark_as_failed(Seq,Mod,Func,SeqTCs)
	    end	    
    end,
    io:format(user, "~n- - - - - - - - - - - - - - - - "
	      "- - - - - - - - - -~n~n", []),
    ok.

%% cases in seq that have already run
mark_as_failed(Seq,Mod,Func,[Func|TCs]) ->
    mark_as_failed1(Seq,Mod,Func,TCs);
mark_as_failed(Seq,Mod,Func,[_TC|TCs]) ->
    mark_as_failed(Seq,Mod,Func,TCs);
mark_as_failed(_,_,_,[]) ->
    ok;
mark_as_failed(_,_,_,undefined) ->
    ok.

%% mark rest of cases in seq to be skipped
mark_as_failed1(Seq,Mod,Func,[TC|TCs]) ->
    ct_util:save_suite_data({seq,Mod,TC},{failed,Seq,Func}),
    mark_as_failed1(Seq,Mod,Func,TCs);
mark_as_failed1(_,_,_,[]) ->
    ok.

group_or_func(Func, Config) when Func == init_per_group; 
				 Func == end_per_group ->
    case proplists:get_value(tc_group_properties,Config) of
	undefined ->
	    {Func,unknown,[]};
	GrProps ->
	    GrName = proplists:get_value(name,GrProps),
	    {Func,GrName,proplists:delete(name,GrProps)}
    end;	  
group_or_func(Func, _Config) ->
    Func.

%%%-----------------------------------------------------------------
%%% @spec get_suite(Mod, Func) -> Tests
%%%
%%% @doc Called from test_server for every suite (<code>Func==all</code>)
%%%      and every test case. If the former, all test cases in the suite
%%%      should be returned. 

get_suite(Mod, all) ->
    case catch apply(Mod, groups, []) of
	{'EXIT',_} ->
	    get_all(Mod, []);
	GroupDefs when is_list(GroupDefs) ->
	    case catch find_groups(Mod, all, all, GroupDefs) of
		{error,_} = Error ->
		    %% this makes test_server call error_in_suite as first
		    %% (and only) test case so we can report Error properly
		    [{?MODULE,error_in_suite,[[Error]]}];
		ConfTests ->
		    get_all(Mod, ConfTests)
	    end;
	_ ->
	    E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
	    [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]
    end;

%%!============================================================
%%! Note: The handling of sequences in get_suite/2 and get_all/2
%%! is deprecated and should be removed at some point...
%%!============================================================

%% group
get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
    Name = proplists:get_value(name, Props),
    case catch apply(Mod, groups, []) of
	{'EXIT',_} ->
	    [Group];
	GroupDefs when is_list(GroupDefs) ->
	    case catch find_groups(Mod, Name, TCs, GroupDefs) of
		{error,_} = Error ->
		    %% this makes test_server call error_in_suite as first
		    %% (and only) test case so we can report Error properly
		    [{?MODULE,error_in_suite,[[Error]]}];
		[] ->
		    {error,{invalid_group_spec,Name}};
		ConfTests ->
		    case lists:member(skipped, Props) of
			true ->
			    %% a *subgroup* specified *only* as skipped (and not
			    %% as an explicit test) should not be returned, or
			    %% init/end functions for top groups will be executed
			    case catch proplists:get_value(name, element(2, hd(ConfTests))) of
				Name ->		% top group
				    ConfTests;
				_ ->
				    []
			    end;
			false ->
			    ConfTests
		    end
	    end;
	_ ->
	    E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
	    [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]
    end;

%% testcase
get_suite(Mod, Name) ->
     get_seq(Mod, Name).

%%%-----------------------------------------------------------------

find_groups(Mod, Name, TCs, GroupDefs) ->
    Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false),
    Trimmed = trim(Found),
    delete_subs(Trimmed, Trimmed).

find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) ->
    cyclic_test(Mod, Name, Known),
    [make_conf(Mod, Name, Props,
	       find(Mod, all, all, Tests, [Name | Known], Defs, true)) |
     find(Mod, all, all, Gs, [], Defs, true)];

find(Mod, Name, TCs, [{Name,Props,Tests} | _Gs], Known, Defs, false)
  when is_atom(Name), is_list(Props), is_list(Tests) ->
    cyclic_test(Mod, Name, Known),
    case TCs of
	all ->
	    [make_conf(Mod, Name, Props,
		       find(Mod, Name, TCs, Tests, [Name | Known], Defs, true))];
	_ ->
	    Tests1 = [TC || TC <- TCs,
			    lists:member(TC, Tests) == true],
	    [make_conf(Mod, Name, Props, Tests1)]
    end;

find(Mod, Name, TCs, [{Name1,Props,Tests} | Gs], Known, Defs, false)
  when is_atom(Name1), is_list(Props), is_list(Tests) ->
    cyclic_test(Mod, Name1, Known),
    [make_conf(Mod, Name1, Props,
	       find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) |
     find(Mod, Name, TCs, Gs, [], Defs, false)];

find(Mod, Name, _TCs, [{Name,_Props,_Tests} | _Gs], _Known, _Defs, true)
  when is_atom(Name) ->
    E = "Duplicate groups named "++atom_to_list(Name)++" in "++
	atom_to_list(Mod)++":groups/0",
    throw({error,list_to_atom(E)});

find(Mod, Name, all, [{Name1,Props,Tests} | Gs], Known, Defs, true)
  when is_atom(Name1), is_list(Props), is_list(Tests) ->
    cyclic_test(Mod, Name1, Known),
    [make_conf(Mod, Name1, Props,
	       find(Mod, Name, all, Tests, [Name1 | Known], Defs, true)) |
     find(Mod, Name, all, Gs, [], Defs, true)];

find(Mod, Name, TCs, [{group,Name1} | Gs], Known, Defs, Found) when is_atom(Name1) ->
    find(Mod, Name, TCs, [expand(Mod, Name1, Defs) | Gs], Known, Defs, Found);

find(Mod, Name, TCs, [{Name1,Tests} | Gs], Known, Defs, Found)
  when is_atom(Name1), is_list(Tests) ->
    find(Mod, Name, TCs, [{Name1,[],Tests} | Gs], Known, Defs, Found);

find(Mod, Name, TCs, [TC | Gs], Known, Defs, false) when is_atom(TC) ->
    find(Mod, Name, TCs, Gs, Known, Defs, false);

find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) ->
    [TC | find(Mod, Name, TCs, Gs, Known, Defs, true)];

find(Mod, _Name, _TCs, [BadTerm | _Gs], Known, _Defs, _Found) ->
    Where = if length(Known) == 0 ->
		    atom_to_list(Mod)++":groups/0";
	       true ->
		    "group "++atom_to_list(lists:last(Known))++
			" in "++atom_to_list(Mod)++":groups/0"
	    end,		 
    Term = io_lib:format("~p", [BadTerm]),
    E = "Bad term "++lists:flatten(Term)++" in "++Where,
    throw({error,list_to_atom(E)});

find(_Mod, _Name, _TCs,  [], _Known, _Defs, false) ->
    ['$NOMATCH'];

find(_Mod, _Name, _TCs,  [], _Known, _Defs, _Found) ->
    [].

delete_subs([Conf | Confs], All) ->
    All1 = delete_conf(Conf, All),
    case is_sub(Conf, All1) of
	true ->
	    delete_subs(Confs, All1);
	false ->
	    delete_subs(Confs, All)
    end;

delete_subs([], All) ->
    All.

delete_conf({conf,Props,_,_,_}, Confs) ->
    Name = proplists:get_value(name, Props),
    [Conf || Conf = {conf,Props0,_,_,_} <- Confs,
	     Name =/= proplists:get_value(name, Props0)].

is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) ->
    Name = proplists:get_value(name, Props),
    case lists:any(fun({conf,Props0,_,_,_}) ->
			   case proplists:get_value(name, Props0) of
			       N when N == Name ->
				   true;
			       _ ->
				   false
			   end;
		      (_) ->
			   false
		   end, Tests) of
	true ->
	    true;
	false ->
	    is_sub(Conf, Tests) or is_sub(Conf, Confs)
    end;

is_sub(Conf, [_TC | Tests]) ->
    is_sub(Conf, Tests);

is_sub(_Conf, []) ->
    false.

trim(['$NOMATCH' | Tests]) ->
    trim(Tests);

trim([{conf,Props,Init,Tests,End} | Confs]) ->
    case trim(Tests) of
	[] ->
	    trim(Confs);
	Trimmed ->
	    [{conf,Props,Init,Trimmed,End} | trim(Confs)]
    end;

trim([TC | Tests]) ->
    [TC | trim(Tests)];

trim([]) ->
    [].

cyclic_test(Mod, Name, Names) ->
    case lists:member(Name, Names) of
	true ->
	    E = "Cyclic reference to group "++atom_to_list(Name)++
		" in "++atom_to_list(Mod)++":groups/0",
	    throw({error,list_to_atom(E)});
	false ->
	    ok
    end.

expand(Mod, Name, Defs) ->
    case lists:keysearch(Name, 1, Defs) of
	{value,Def} -> 
	    Def;
	false ->
	    E = "Invalid group "++atom_to_list(Name)++
		" in "++atom_to_list(Mod)++":groups/0",
	    throw({error,list_to_atom(E)})
    end.

make_all_conf(Dir, Mod, _Props) ->
    case code:is_loaded(Mod) of
	false ->
	    code:load_abs(filename:join(Dir,atom_to_list(Mod)));
	_ ->
	    ok
    end,
    make_all_conf(Mod).

make_all_conf(Mod) ->
    case catch apply(Mod, groups, []) of
	{'EXIT',_} ->
	    {error,{invalid_group_definition,Mod}};
	GroupDefs when is_list(GroupDefs) ->
	    case catch find_groups(Mod, all, all, GroupDefs) of
		{error,_} = Error ->
		    %% this makes test_server call error_in_suite as first
		    %% (and only) test case so we can report Error properly
		    [{?MODULE,error_in_suite,[[Error]]}];
		[] ->
		    {error,{invalid_group_spec,Mod}};
		ConfTests ->
		    [{conf,Props,Init,all,End} || {conf,Props,Init,_,End} <- ConfTests]
	    end
    end.

make_conf(Dir, Mod, Name, Props, TestSpec) ->
    case code:is_loaded(Mod) of
	false ->
	    code:load_abs(filename:join(Dir,atom_to_list(Mod)));
	_ ->
	    ok
    end,
    make_conf(Mod, Name, Props, TestSpec).

make_conf(Mod, Name, Props, TestSpec) ->
    case code:is_loaded(Mod) of
	false ->
	    code:load_file(Mod);
	_ ->
	    ok
    end,
    {InitConf,EndConf} =
	case erlang:function_exported(Mod,init_per_group,2) of
	    true ->
		{{Mod,init_per_group},{Mod,end_per_group}};
	    false ->
		{{?MODULE,ct_init_per_group},
		 {?MODULE,ct_end_per_group}}
	end,
    {conf,[{name,Name}|Props],InitConf,TestSpec,EndConf}.

%%%-----------------------------------------------------------------

get_all(Mod, ConfTests) ->	
    case catch apply(Mod, all, []) of
	{'EXIT',_} ->
	    Reason = 
		list_to_atom(atom_to_list(Mod)++":all/0 is missing"),
	    %% this makes test_server call error_in_suite as first
	    %% (and only) test case so we can report Reason properly
	    [{?MODULE,error_in_suite,[[{error,Reason}]]}];
	AllTCs when is_list(AllTCs) ->
	    case catch save_seqs(Mod,AllTCs) of
		{error,What} ->
		    [{?MODULE,error_in_suite,[[{error,What}]]}];
		SeqsAndTCs ->
		    %% expand group references in all() using ConfTests
		    Expand =
			fun({group,Name}) ->
				FindConf = 
				    fun({conf,Props,_,_,_}) ->
					    case proplists:get_value(name, Props) of
						Name -> true;
						_    -> false
					    end
					   end,					 
				case lists:filter(FindConf, ConfTests) of
				    [ConfTest|_] ->
					ConfTest;
				    [] ->
					E = "Invalid reference to group "++
					    atom_to_list(Name)++" in "++
					    atom_to_list(Mod)++":all/0",
					throw({error,list_to_atom(E)})
				end;
			   (SeqOrTC) -> SeqOrTC
			end,
		    case catch lists:map(Expand, SeqsAndTCs) of
			{error,_} = Error ->
			    [{?MODULE,error_in_suite,[[Error]]}];
			Tests ->
			    Tests
		    end
	    end;
	Skip = {skip,_Reason} ->
	    Skip;
	_ ->
	    Reason = 
		list_to_atom("Bad return value from "++atom_to_list(Mod)++":all/0"),
	    [{?MODULE,error_in_suite,[[{error,Reason}]]}]
    end.


%%!============================================================
%%! The support for sequences by means of using sequences/0
%%! will be removed in OTP R14. The code below is only kept 
%%! for backwards compatibility. From OTP R13 groups with
%%! sequence property should be used instead!
%%!============================================================
%%!============================================================
%%! START OF DEPRECATED SUPPORT FOR SEQUENCES --->

get_seq(Mod, Func) ->
    case ct_util:read_suite_data({seq,Mod,Func}) of
	undefined ->
	    case catch apply(Mod,sequences,[]) of
		{'EXIT',_} ->
		    [];
		Seqs ->
		    case lists:keysearch(Func,1,Seqs) of
			{value,{Func,SeqTCs}} ->			    
			    case catch save_seq(Mod,Func,SeqTCs) of
				{error,What} ->
				    [{?MODULE,error_in_suite,[[{error,What}]]}];
				_ ->
				    SeqTCs
			    end;
			false ->
			    []
		    end
	    end;
	TCs when is_list(TCs) ->
	    TCs;
	_ ->
	    []
    end.

save_seqs(Mod,AllTCs) ->
    case lists:keymember(sequence,1,AllTCs) of
	true ->
	    case catch apply(Mod,sequences,[]) of
		{'EXIT',_} -> 
		    Reason = list_to_atom(atom_to_list(Mod)++
					  ":sequences/0 is missing"),
		    throw({error,Reason});
		Seqs ->
		    save_seqs(Mod,AllTCs,Seqs,AllTCs)
	    end;
	false ->
	    AllTCs
    end.
    
save_seqs(Mod,[{sequence,Seq}|TCs],Seqs,All) ->
    case lists:keysearch(Seq,1,Seqs) of
	{value,{Seq,SeqTCs}} ->
	    save_seq(Mod,Seq,SeqTCs,All),
	    [Seq|save_seqs(Mod,TCs,Seqs,All)];
	false ->
	    Reason = list_to_atom(
		       atom_to_list(Seq)++" is missing in "++
		       atom_to_list(Mod)),
	    throw({error,Reason})
    end;
save_seqs(Mod,[TC|TCs],Seqs,All) ->
    [TC|save_seqs(Mod,TCs,Seqs,All)];
save_seqs(_,[],_,_) ->
    [].

save_seq(Mod,Seq,SeqTCs) ->
    save_seq(Mod,Seq,SeqTCs,apply(Mod,all,[])).
    
save_seq(Mod,Seq,SeqTCs,All) ->
    check_private(Seq,SeqTCs,All),
    check_multiple(Mod,Seq,SeqTCs),
    ct_util:save_suite_data({seq,Mod,Seq},SeqTCs),
    lists:foreach(fun(TC) -> 
			  ct_util:save_suite_data({seq,Mod,TC},Seq)
		  end, SeqTCs).

check_private(Seq,TCs,All) ->    
    Bad = lists:filter(fun(TC) -> lists:member(TC,All) end, TCs),
    if Bad /= [] ->
	    Reason = io_lib:format("regular test cases not allowed in sequence ~p: "
				   "~p",[Seq,Bad]),
	    throw({error,list_to_atom(lists:flatten(Reason))});
       true ->
	    ok
    end.

check_multiple(Mod,Seq,TCs) ->
    Bad = lists:filter(fun(TC) ->
			       case ct_util:read_suite_data({seq,Mod,TC}) of
				   Seq1 when Seq1 /= undefined, Seq1 /= Seq -> 
				       true;

				   _ -> false
			       end
		       end,TCs),
    if Bad /= [] ->
	    Reason = io_lib:format("test cases found in multiple sequences: "
				   "~p",[Bad]),
	    throw({error,list_to_atom(lists:flatten(Reason))});
       true ->
	    ok
    end.

%%! <---  END OF DEPRECATED SUPPORT FOR SEQUENCES
%%!============================================================

%% let test_server call this function as a testcase only so that
%% the user may see info about what's missing in the suite
error_in_suite(Config) ->
    Reason = test_server:lookup_config(error,Config),
    exit(Reason).

%% if the group config functions are missing in the suite,
%% use these instead
ct_init_per_group(GroupName, Config) ->
    ct_logs:log("WARNING", "init_per_group/2 for ~w missing in suite, using default.", 
		[GroupName]),
    Config.

ct_end_per_group(GroupName, _) ->
    ct_logs:log("WARNING", "end_per_group/2 for ~w missing in suite, using default.", 
		[GroupName]),
    ok.

    
%%%-----------------------------------------------------------------
%%% @spec report(What,Data) -> ok
report(What,Data) ->
    case What of
	tests_start ->
	    case ct_util:get_testdata(cover) of
		undefined -> 
		    ok;
		{_CovFile,_CovNodes,CovImport,CovExport,_CovAppData} ->
		    %% Always import cover data from files specified by CovImport 
		    %% if no CovExport defined. If CovExport is defined, only
		    %% import from CovImport files initially, then use CovExport
		    %% to pass coverdata between proceeding tests (in the same run).
		    Imps =
			case CovExport of
			    [] ->  % don't export data between tests
				CovImport;
			    _ ->
				case filelib:is_file(CovExport) of
				    true ->
					[CovExport];
				    false ->
					CovImport
				end
			end,
		    lists:foreach(
		      fun(Imp) ->
			      case cover:import(Imp) of
				  ok -> 
				      ok;
				  {error,Reason} ->
				      ct_logs:log("COVER INFO",
						  "Importing cover data from: ~s fails! "
						  "Reason: ~p", [Imp,Reason])
			      end
		      end, Imps)
	    end;
	tests_done ->
	    ok;
	tc_start ->
	    ok;
	tc_done ->
	    {_Suite,Case,Result} = Data,
	    case {Case,Result} of
		{init_per_suite,_} ->
		    ok;
		{end_per_suite,_} ->
		    ok;
		{init_per_group,_} ->
		    ok;
		{end_per_group,_} ->
		    ok;
		{_,ok} ->
		    add_to_stats(ok);
		{_,{skipped,{failed,{_,init_per_testcase,_}}}} ->
		    add_to_stats(auto_skipped);
		{_,{skipped,{require_failed,_}}} ->
		    add_to_stats(auto_skipped);
		{_,{skipped,_}} ->
		    add_to_stats(user_skipped);
		{_,{FailOrSkip,_Reason}} ->
		    add_to_stats(FailOrSkip)
	    end;
	tc_user_skip ->	    
	    %% test case specified as skipped in testspec
	    %% Data = {Suite,Case,Comment}
	    ct_event:sync_notify(#event{name=tc_user_skip,
					node=node(),
					data=Data}),
	    add_to_stats(user_skipped);
	tc_auto_skip ->
	    %% test case skipped because of error in init_per_suite
	    %% Data = {Suite,Case,Comment}

	    {_Suite,Case,_Result} = Data,

	    %% this test case does not have a log, so printouts
	    %% from event handlers should end up in the main log
	    ct_event:sync_notify(#event{name=tc_auto_skip,
					node=node(),
					data=Data}),
	    if Case /= end_per_suite, Case /= end_per_group -> 
		    add_to_stats(auto_skipped);
	       true -> 
		    ok
	    end;
	_ ->
	    ok
    end,
    catch vts:report(What,Data).

add_to_stats(Result) ->
    Update = fun({Ok,Failed,Skipped={UserSkipped,AutoSkipped}}) ->
		     Stats =
			 case Result of
			     ok ->
				 {Ok+1,Failed,Skipped};
			     failed ->
				 {Ok,Failed+1,Skipped};
			     skipped ->
				 {Ok,Failed,{UserSkipped+1,AutoSkipped}};
			     user_skipped ->
				 {Ok,Failed,{UserSkipped+1,AutoSkipped}};
			     auto_skipped ->
				 {Ok,Failed,{UserSkipped,AutoSkipped+1}}
			 end,
		     ct_event:sync_notify(#event{name=test_stats,
						 node=node(),
						 data=Stats}),
		     Stats
	     end,
    ct_util:update_testdata(stats, Update).

%%%-----------------------------------------------------------------
%%% @spec warn(What) -> true | false
warn(What) when What==nodes; What==processes ->
    false;
warn(_What) ->
    true.

%%%-----------------------------------------------------------------
%%% @spec add_data_dir(File0) -> File1
add_data_dir(File,Config) when is_atom(File) ->
    add_data_dir(atom_to_list(File),Config);

add_data_dir(File,Config) when is_list(File) ->
    case filename:split(File) of
	[File] ->
	    %% no user path, add data dir
	    case lists:keysearch(data_dir,1,Config) of
		{value,{data_dir,DataDir}} ->
		    filename:join(DataDir,File);
		_ ->
		    File
	    end;
	_ ->
	    File
    end.

%%%-----------------------------------------------------------------
%%% @spec overview_html_header(TestName) -> Header
overview_html_header(TestName) ->
    TestName1 = lists:flatten(io_lib:format("~p", [TestName])),
    Label = case application:get_env(common_test, test_label) of
		{ok,Lbl} when Lbl =/= undefined ->
		    "<H1><FONT color=\"green\">" ++ Lbl ++ "</FONT></H1>\n";
		_        ->
		    ""
	    end,
    Bgr = case ct_logs:basic_html() of
	      true ->
		  "";
	      false ->
		  CTPath = code:lib_dir(common_test),
		  TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
		  " background=\"" ++ TileFile ++ "\""
	  end,

    ["<html>\n",
     "<head><title>Test ", TestName1, " results</title>\n",
     "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
     "</head>\n",
     "<body", Bgr, " bgcolor=\"white\" text=\"black\" ",
     "link=\"blue\" vlink=\"purple\" alink=\"red\">\n",
     Label,
     "<H2>Results from test ", TestName1, "</H2>\n"].