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