1: %% -*- coding: utf-8 -*-
    2: %%
    3: %% %CopyrightBegin%
    4: %%
    5: %% Copyright Ericsson AB 2010-2013. All Rights Reserved.
    6: %%
    7: %% The contents of this file are subject to the Erlang Public License,
    8: %% Version 1.1, (the "License"); you may not use this file except in
    9: %% compliance with the License. You should have received a copy of the
   10: %% Erlang Public License along with this software. If not, it can be
   11: %% retrieved online at http://www.erlang.org/.
   12: %%
   13: %% Software distributed under the License is distributed on an "AS IS"
   14: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   15: %% the License for the specific language governing rights and limitations
   16: %% under the License.
   17: %%
   18: %% %CopyrightEnd%
   19: %%
   20: %%%-------------------------------------------------------------------
   21: %%% @author Lukas Larsson <lukas@erlang-solutions.com>
   22: %%% @copyright (C) 2011, Erlang Solutions Ltd.
   23: %%% @doc
   24: %%%
   25: %%% @end
   26: %%% Created : 15 Feb 2011 by Lukas Larsson <lukas@erlang-solutions.com>
   27: %%%-------------------------------------------------------------------
   28: -module(test_server_SUITE).
   29: 
   30: %% Note: This directive should only be used in test suites.
   31: -compile(export_all).
   32: 
   33: -include_lib("common_test/include/ct.hrl").
   34: -include("test_server_test_lib.hrl").
   35: -include_lib("kernel/include/file.hrl").
   36: 
   37: %%--------------------------------------------------------------------
   38: %% COMMON TEST CALLBACK FUNCTIONS
   39: %%--------------------------------------------------------------------
   40: 
   41: %% @spec suite() -> Info
   42: suite() ->
   43:     [{ct_hooks,[ts_install_cth,test_server_test_lib]}].
   44: 
   45: 
   46: %% @spec init_per_suite(Config0) ->
   47: %%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
   48: init_per_suite(Config) ->
   49:     [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config].
   50: 
   51: %% @spec end_per_suite(Config) -> _
   52: end_per_suite(_Config) ->
   53:     io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]),
   54:     ok.
   55: 
   56: %% @spec init_per_group(GroupName, Config0) ->
   57: %%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
   58: init_per_group(_GroupName, Config) ->
   59:     Config.
   60: 
   61: %% @spec end_per_group(GroupName, Config0) ->
   62: %%               void() | {save_config,Config1}
   63: end_per_group(_GroupName, _Config) ->
   64:     ok.
   65: 
   66: %% @spec init_per_testcase(TestCase, Config0) ->
   67: %%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
   68: init_per_testcase(_TestCase, Config) ->
   69:     Config.
   70: 
   71: %% @spec end_per_testcase(TestCase, Config0) ->
   72: %%               void() | {save_config,Config1} | {fail,Reason}
   73: end_per_testcase(test_server_unicode, _Config) ->
   74:     [_,Host] = string:tokens(atom_to_list(node()), "@"),
   75:     N1 = list_to_atom("test_server_tester_latin1" ++ "@" ++ Host),
   76:     N2 = list_to_atom("test_server_tester_utf8" ++ "@" ++ Host),
   77:     test_server:stop_node(N1),
   78:     test_server:stop_node(N2),
   79:     ok;
   80: end_per_testcase(_TestCase, _Config) ->
   81:     ok.
   82: 
   83: %% @spec: groups() -> [Group]
   84: groups() ->
   85:     [].
   86: 
   87: %% @spec all() -> GroupsAndTestCases | {skip,Reason}
   88: all() ->
   89:     [test_server_SUITE, test_server_parallel01_SUITE,
   90:      test_server_conf02_SUITE, test_server_conf01_SUITE,
   91:      test_server_skip_SUITE, test_server_shuffle01_SUITE,
   92:      test_server_break_SUITE, test_server_cover_SUITE,
   93:      test_server_unicode].
   94: 
   95: 
   96: %%--------------------------------------------------------------------
   97: %% TEST CASES
   98: %%--------------------------------------------------------------------
   99: %% @spec TestCase(Config0) ->
  100: %%           ok | exit() | {skip,Reason} | {comment,Comment} |
  101: %%           {save_config,Config1} | {skip_and_save,Reason,Config1}
  102: test_server_SUITE(Config) ->
  103: %    rpc:call(Node,dbg, tracer,[]),
  104: %    rpc:call(Node,dbg, p,[all,c]),
  105: %    rpc:call(Node,dbg, tpl,[test_server_ctrl,x]),
  106:     run_test_server_tests("test_server_SUITE",
  107: 			  [{test_server_SUITE,skip_case7,"SKIPPED!"}],
  108: 			  40, 1, 32, 21, 9, 1, 11, 2, 27, Config).
  109: 
  110: test_server_parallel01_SUITE(Config) ->
  111:     run_test_server_tests("test_server_parallel01_SUITE", [],
  112: 			  37, 0, 19, 19, 0, 0, 0, 0, 37, Config).
  113: 
  114: test_server_shuffle01_SUITE(Config) ->
  115:     run_test_server_tests("test_server_shuffle01_SUITE", [],
  116: 			  130, 0, 0, 76, 0, 0, 0, 0, 130, Config).
  117: 
  118: test_server_skip_SUITE(Config) ->
  119:     run_test_server_tests("test_server_skip_SUITE", [],
  120: 			  3, 0, 1, 0, 1, 0, 3, 0, 0, Config).
  121: 
  122: test_server_conf01_SUITE(Config) ->
  123:     run_test_server_tests("test_server_conf01_SUITE", [],
  124: 			  24, 0, 12, 12, 0, 0, 0, 0, 24, Config).
  125: 
  126: test_server_conf02_SUITE(Config) ->
  127:     run_test_server_tests("test_server_conf02_SUITE", [],
  128: 			  26, 0, 12, 12, 0, 0, 0, 0, 26, Config).
  129: 
  130: test_server_break_SUITE(Config) ->
  131:     run_test_server_tests("test_server_break_SUITE", [],
  132: 			  8, 2, 6, 4, 0, 0, 0, 2, 6, Config).
  133: 
  134: test_server_cover_SUITE(Config) ->
  135:     case test_server:is_cover() of
  136: 	true ->
  137: 	    {skip, "Cover already running"};
  138: 	false ->
  139: 	    PrivDir = ?config(priv_dir,Config),
  140: 
  141: 	    %% Test suite has two test cases
  142: 	    %%   tc1 calls cover_helper:foo/0
  143: 	    %%   tc2 calls cover_helper:bar/0
  144: 	    %% Each function in cover_helper is one line.
  145: 	    %%
  146: 	    %% First test run skips tc2, so only cover_helper:foo/0 is executed.
  147: 	    %% Cover file specifies to include cover_helper in this test run.
  148: 	    CoverFile1 = filename:join(PrivDir,"t1.cover"),
  149: 	    CoverSpec1 = {include,[cover_helper]},
  150: 	    file:write_file(CoverFile1,io_lib:format("~p.~n",[CoverSpec1])),
  151: 	    run_test_server_tests("test_server_cover_SUITE",
  152: 				  [{test_server_cover_SUITE,tc2,"SKIPPED!"}],
  153: 				  4, 0, 2, 1, 1, 0, 1, 0, 3,
  154: 				  CoverFile1, Config),
  155: 
  156: 	    %% Next test run skips tc1, so only cover_helper:bar/0 is executed.
  157: 	    %% Cover file specifies cross compilation of cover_helper
  158: 	    CoverFile2 = filename:join(PrivDir,"t2.cover"),
  159: 	    CoverSpec2 = {cross,[{t1,[cover_helper]}]},
  160: 	    file:write_file(CoverFile2,io_lib:format("~p.~n",[CoverSpec2])),
  161: 	    run_test_server_tests("test_server_cover_SUITE",
  162: 				  [{test_server_cover_SUITE,tc1,"SKIPPED!"}],
  163: 				  4, 0, 2, 1, 1, 0, 1, 0, 3, CoverFile2, Config),
  164: 
  165: 	    %% Cross cover analyse
  166: 	    WorkDir = ?config(work_dir,Config),
  167: 	    WC = filename:join([WorkDir,"test_server_cover_SUITE.logs","run.*"]),
  168: 	    [D2,D1|_] = lists:reverse(lists:sort(filelib:wildcard(WC))),
  169: 	    TagDirs = [{t1,D1},{t2,D2}],
  170: 	    test_server_ctrl:cross_cover_analyse(details,TagDirs),
  171: 
  172: 	    %% Check that cover log shows only what is really included
  173: 	    %% in the test and cross cover log show the accumulated
  174: 	    %% result.
  175: 	    {ok,Cover1} = file:read_file(filename:join(D1,"cover.log")),
  176: 	    [{cover_helper,{1,1,_}}] = binary_to_term(Cover1),
  177: 	    {ok,Cover2} = file:read_file(filename:join(D2,"cover.log")),
  178: 	    [] = binary_to_term(Cover2),
  179: 	    {ok,Cross} = file:read_file(filename:join(D1,"cross_cover.log")),
  180: 	    [{cover_helper,{2,0,_}}] = binary_to_term(Cross),
  181: 	    ok
  182:     end.
  183: 
  184: test_server_unicode(Config) ->
  185:     run_test_server_tests("test_server_unicode_SUITE", [],
  186: 			  5, 0, 3, 3, 0, 0, 0, 0, 5, Config),
  187: 
  188:     %% Create and run two test suites - one with filename and content
  189:     %% in latin1 (if the default filename mode is latin1) and one with
  190:     %% filename and content in utf8.  Both have name and content
  191:     %% including letters äöå.  Check that all logs are generated with
  192:     %% utf8 encoded filenames.
  193:     case file:native_name_encoding() of
  194: 	utf8 ->
  195: 	    ok;
  196: 	latin1 ->
  197: 	    generate_and_run_unicode_test(Config,latin1)
  198:     end,
  199:     generate_and_run_unicode_test(Config,utf8).
  200: 
  201: %%%-----------------------------------------------------------------
  202: run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc,
  203: 		      NUsrSkip, NAutoSkip, 
  204: 		      NActualSkip, NActualFail, NActualSucc, Config) ->
  205:     run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc,
  206: 			  NUsrSkip, NAutoSkip,
  207: 			  NActualSkip, NActualFail, NActualSucc, false, Config).
  208: 
  209: run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc,
  210: 		      NUsrSkip, NAutoSkip,
  211: 		      NActualSkip, NActualFail, NActualSucc, Cover, Config) ->
  212:     Node = proplists:get_value(node, Config),
  213:     Encoding = rpc:call(Node,file,native_name_encoding,[]),
  214:     WorkDir = proplists:get_value(work_dir, Config),
  215:     LogDir = filename:join(WorkDir, SuiteName++".logs"),
  216:     LogDirUri = test_server_ctrl:uri_encode(LogDir, Encoding),
  217:     ct:log("<a href=\"file://~s\">Test case log files</a>\n", [LogDirUri]),
  218: 
  219:     {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []),
  220:     case Cover of
  221: 	false ->
  222: 	    ok;
  223: 	_ ->
  224: 	    rpc:call(Node,test_server_ctrl,cover,[Cover,details])
  225:     end,
  226:     rpc:call(Node,
  227: 	     test_server_ctrl,add_dir_with_skip,
  228: 	     [SuiteName, 
  229: 	      [proplists:get_value(data_dir,Config)],SuiteName,
  230: 	      Skip]),
  231: 
  232:     until(fun() ->
  233: 		  rpc:call(Node,test_server_ctrl,jobs,[]) =:= []
  234: 	  end),
  235:     
  236:     rpc:call(Node,test_server_ctrl, stop, []),
  237: 
  238:     LogDir1 = translate_filename(LogDir,Encoding),
  239:     LastRunDir = get_latest_run_dir(LogDir1),
  240:     LastSuiteLog = filename:join(LastRunDir,"suite.log"),
  241:     {ok,Data} =	test_server_test_lib:parse_suite(LastSuiteLog),
  242:     check([{"Number of cases",NCases,Data#suite.n_cases},
  243: 	   {"Number failed",NFail,Data#suite.n_cases_failed},
  244: 	   {"Number expected",NExpected,Data#suite.n_cases_expected},
  245: 	   {"Number successful",NSucc,Data#suite.n_cases_succ},
  246: 	   {"Number user skipped",NUsrSkip,Data#suite.n_cases_user_skip},
  247: 	   {"Number auto skipped",NAutoSkip,Data#suite.n_cases_auto_skip}], ok),
  248:     {NActualSkip,NActualFail,NActualSucc} = 
  249: 	lists:foldl(fun(#tc{ result = skip },{S,F,Su}) ->
  250: 			     {S+1,F,Su};
  251: 		       (#tc{ result = auto_skip },{S,F,Su}) ->
  252: 			    {S+1,F,Su};
  253: 		       (#tc{ result = ok },{S,F,Su}) ->
  254: 			    {S,F,Su+1};
  255: 		       (#tc{ result = failed },{S,F,Su}) ->
  256: 			    {S,F+1,Su}
  257: 		    end,{0,0,0},Data#suite.cases),
  258:     Data.
  259: 
  260: translate_filename(Filename,EncodingOnTestNode) ->
  261:     case {file:native_name_encoding(),EncodingOnTestNode} of
  262: 	{X,X} -> Filename;
  263: 	{utf8,latin1} -> list_to_binary(Filename);
  264: 	{latin1,utf8} -> unicode:characters_to_binary(Filename)
  265:     end.
  266: 
  267: get_latest_run_dir(Dir) ->
  268:     %% For the time being, filelib:wildcard can not take a binary
  269:     %% argument, so we avoid using this here.
  270:     case file:list_dir(Dir) of
  271: 	{ok,Files} ->
  272: 	    {ok,RE} = re:compile(<<"^run.[1-2][-_\.0-9]*$">>),
  273: 	    RunDirs = lists:filter(
  274: 			fun(F) ->
  275: 				L = l(F),
  276: 				case re:run(F,RE) of
  277: 				    {match,[{0,L}]} -> true;
  278: 				    _ -> false
  279: 				end
  280: 			end, Files),
  281: 	    case RunDirs of
  282: 		[] ->
  283: 		    Dir;
  284: 		[H|T] ->
  285: 		    filename:join(Dir,get_latest_dir(T,H))
  286: 	    end;
  287: 	_ ->
  288: 	    Dir
  289:     end.
  290: 
  291: l(X) when is_binary(X) -> size(X);
  292: l(X) when is_list(X) -> length(X).
  293: 
  294: get_latest_dir([H|T],Latest) when H>Latest ->
  295:     get_latest_dir(T,H);
  296: get_latest_dir([_|T],Latest) ->
  297:     get_latest_dir(T,Latest);
  298: get_latest_dir([],Latest) ->
  299:     Latest.
  300: 
  301: check([{Str,Same,Same}|T], Status) ->
  302:     io:format("~s: ~p\n", [Str,Same]),
  303:     check(T, Status);
  304: check([{Str,Expected,Actual}|T], _) ->
  305:     io:format("~s: expected ~p, actual ~p\n", [Str,Expected,Actual]),
  306:     check(T, error);
  307: check([], ok) -> ok;
  308: check([], error) -> ?t:fail().
  309: 
  310: until(Fun) ->
  311:     case Fun() of
  312: 	true ->
  313: 	    ok;
  314: 	false ->
  315: 	    timer:sleep(100),
  316: 	    until(Fun)
  317:     end.
  318: 
  319: generate_and_run_unicode_test(Config0,Encoding) ->
  320:     DataDir = ?config(data_dir,Config0),
  321:     Suite = create_unicode_test_suite(DataDir,Encoding),
  322: 
  323:     %% We can not run this test on default node since it must be
  324:     %% started with correct file name mode (+fnu/+fnl).
  325:     %% OBS: the node are stopped by end_per_testcase/2
  326:     Config1 = lists:keydelete(node,1,Config0),
  327:     Config2 = lists:keydelete(work_dir,1,Config1),
  328:     NodeName = list_to_atom("test_server_tester_" ++ atom_to_list(Encoding)),
  329:     Config = start_node(Config2,NodeName,erts_switch(Encoding)),
  330: 
  331:     %% Compile the suite
  332:     Node = proplists:get_value(node,Config),
  333:     {ok,Mod} = rpc:call(Node,compile,file,[Suite,[{outdir,DataDir}]]),
  334:     ModStr = atom_to_list(Mod),
  335: 
  336:     %% Clean logdir
  337:     LogDir0 = filename:join(DataDir,ModStr++".logs"),
  338:     LogDir = translate_filename(LogDir0,Encoding),
  339:     rm_dir(LogDir),
  340: 
  341:     %% Run the test
  342:     run_test_server_tests(ModStr, [], 3, 0, 1, 1, 0, 0, 0, 0, 3, Config),
  343: 
  344:     %% Check that all logs are created with utf8 encoded filenames
  345:     true = filelib:is_dir(LogDir),
  346: 
  347:     RunDir = get_latest_run_dir(LogDir),
  348:     true = filelib:is_dir(RunDir),
  349: 
  350:     LowerModStr = string:to_lower(ModStr),
  351:     SuiteHtml = translate_filename(LowerModStr++".src.html",Encoding),
  352:     true = filelib:is_regular(filename:join(RunDir,SuiteHtml)),
  353: 
  354:     TCLog = translate_filename(LowerModStr++".tc_äöå.html",Encoding),
  355:     true = filelib:is_regular(filename:join(RunDir,TCLog)),
  356:     ok.
  357: 
  358: %% Same as test_server_test_lib:start_slave, but starts a peer with
  359: %% additional arguments.
  360: %% The reason for this is that we need to start nodes with +fnu/+fnl,
  361: %% and that will not work well with a slave node since slave nodes run
  362: %% remote file system on master - i.e. they will use same file name
  363: %% mode as the master.
  364: start_node(Config,Name,Args) ->
  365:     [_,Host] = string:tokens(atom_to_list(node()), "@"),
  366:     ct:log("Trying to start ~w@~s~n",[Name,Host]),
  367:     case test_server:start_node(Name, peer, [{args,Args}]) of
  368: 	{error,Reason} ->
  369: 	    test_server:fail(Reason);
  370: 	{ok,Node} ->
  371: 	    ct:log("Node ~p started~n", [Node]),
  372: 	    test_server_test_lib:prepare_tester_node(Node,Config)
  373:     end.
  374: 
  375: create_unicode_test_suite(Dir,Encoding) ->
  376:     ModStr = "test_server_"++atom_to_list(Encoding)++"_äöå_SUITE",
  377:     File = filename:join(Dir,ModStr++".erl"),
  378:     Suite =
  379: 	["%% -*- ",epp:encoding_to_string(Encoding)," -*-\n",
  380: 	 "-module(",ModStr,").\n"
  381: 	 "\n"
  382: 	 "-export([all/1, init_per_suite/1, end_per_suite/1]).\n"
  383: 	 "-export([init_per_testcase/2, end_per_testcase/2]).\n"
  384: 	 "-export([tc_äöå/1]).\n"
  385: 	 "\n"
  386: 	 "-include_lib(\"test_server/include/test_server.hrl\").\n"
  387: 	 "\n"
  388: 	 "all(suite) ->\n"
  389: 	 "    [tc_äöå].\n"
  390: 	 "\n"
  391: 	 "init_per_suite(Config) ->\n"
  392: 	 "    Config.\n"
  393: 	 "\n"
  394: 	 "end_per_suite(_Config) ->\n"
  395: 	 "    ok.\n"
  396: 	 "\n"
  397: 	 "init_per_testcase(_Case,Config) ->\n"
  398: 	 "    init_timetrap(500,Config).\n"
  399: 	 "\n"
  400: 	 "init_timetrap(T,Config) ->\n"
  401: 	 "    Dog = ?t:timetrap(T),\n"
  402: 	 "    [{watchdog, Dog}|Config].\n"
  403: 	 "\n"
  404: 	 "end_per_testcase(_Case,Config) ->\n"
  405: 	 "    cancel_timetrap(Config).\n"
  406: 	 "\n"
  407: 	 "cancel_timetrap(Config) ->\n"
  408: 	 "    Dog=?config(watchdog, Config),\n"
  409: 	 "    ?t:timetrap_cancel(Dog),\n"
  410: 	 "    ok.\n"
  411: 	 "\n"
  412: 	 "tc_äöå(Config) when is_list(Config) ->\n"
  413: 	 "    true = filelib:is_dir(?config(priv_dir,Config)),\n"
  414: 	 "    ok.\n"],
  415:     {ok,Fd} = file:open(raw_filename(File,Encoding),[write,{encoding,Encoding}]),
  416:     io:put_chars(Fd,Suite),
  417:     ok = file:close(Fd),
  418:     File.
  419: 
  420: raw_filename(Name,latin1) -> list_to_binary(Name);
  421: raw_filename(Name,utf8)   -> unicode:characters_to_binary(Name).
  422: 
  423: rm_dir(Dir) ->
  424:     case file:list_dir(Dir) of
  425: 	{error,enoent} ->
  426: 	    ok;
  427: 	{ok,Files} ->
  428: 	    rm_files([filename:join(Dir, F) || F <- Files]),
  429: 	    file:del_dir(Dir)
  430:     end.
  431: 
  432: rm_files([F | Fs]) ->
  433:     case file:read_file_info(F) of
  434: 	{ok,#file_info{type=directory}} ->
  435: 	    rm_dir(F),
  436: 	    rm_files(Fs);
  437: 	{ok,_Regular} ->
  438: 	    case file:delete(F) of
  439: 		ok ->
  440: 		    rm_files(Fs);
  441: 		{error,Errno} ->
  442: 		    exit({del_failed,F,Errno})
  443: 	    end
  444:     end;
  445: rm_files([]) ->
  446:     ok.
  447: 
  448: erts_switch(latin1) -> "+fnl";
  449: erts_switch(utf8)   -> "+fnu".