diff options
Diffstat (limited to 'lib/test_server/src')
| -rw-r--r-- | lib/test_server/src/Makefile | 8 | ||||
| -rw-r--r-- | lib/test_server/src/test_server.erl | 6 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_ctrl.erl | 48 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_internal.hrl | 2 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_node.erl | 43 | ||||
| -rw-r--r-- | lib/test_server/src/test_server_sup.erl | 6 | ||||
| -rw-r--r-- | lib/test_server/src/ts.erl | 112 | ||||
| -rw-r--r-- | lib/test_server/src/ts_autoconf_vxworks.erl | 191 | ||||
| -rw-r--r-- | lib/test_server/src/ts_benchmark.erl | 91 | ||||
| -rw-r--r-- | lib/test_server/src/ts_erl_config.erl | 12 | ||||
| -rw-r--r-- | lib/test_server/src/ts_install.erl | 6 | ||||
| -rw-r--r-- | lib/test_server/src/ts_lib.erl | 68 | ||||
| -rw-r--r-- | lib/test_server/src/ts_reports.erl | 545 | ||||
| -rw-r--r-- | lib/test_server/src/ts_run.erl | 27 | ||||
| -rw-r--r-- | lib/test_server/src/ts_selftest.erl | 120 | ||||
| -rw-r--r-- | lib/test_server/src/vxworks_client.erl | 243 |
16 files changed, 192 insertions, 1336 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 513720dc04..bb0b4e55b8 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -44,20 +44,18 @@ MODULES= test_server_ctrl \ test_server \ test_server_sup \ test_server_h \ - erl2html2 \ - vxworks_client + erl2html2 TS_MODULES= \ ts \ ts_run \ - ts_reports \ ts_lib \ ts_make \ ts_erl_config \ ts_autoconf_win32 \ - ts_autoconf_vxworks \ ts_install \ - ts_install_cth + ts_install_cth \ + ts_benchmark TARGET_MODULES= $(MODULES:%=$(EBIN)/%) TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 17c5f5b253..8beed9bd3e 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -2180,14 +2180,10 @@ timetrap_scale_factor() -> {false,true} -> 2 * F0; {false,false} -> F0 end, - F2 = case has_superfluous_schedulers() of + F = case has_superfluous_schedulers() of true -> 3*F1; false -> F1 end, - F = case test_server_sup:get_os_family() of - vxworks -> 5 * F2; - _ -> F2 - end, case test_server:is_cover() of true -> 10 * F; false -> F diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index df2187bc04..88d86285d5 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -430,14 +430,6 @@ run_test(CommandLine) -> testcase_callback(TCCB), add_job(Name, {command_line,SpecList}), - %% adding of jobs involves file i/o which may take long time - %% when running a nfs mounted file system (VxWorks). - case controller_call(get_target_info) of - #target_info{os_family=vxworks} -> - receive after 30000 -> ready_to_wait end; - _ -> - wait_now - end, wait_finish(). %% Converted CoverFile to a string unless it is 'none' @@ -1418,13 +1410,14 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, StartedExtraTools = start_extra_tools(ExtraTools), {TimeMy,Result} = ts_tc(Mod, Func, Args), put(test_server_common_io_handler, undefined), - stop_extra_tools(StartedExtraTools), + catch stop_extra_tools(StartedExtraTools), case Result of {'EXIT',test_suites_done} -> print(25, "DONE, normal exit", []); {'EXIT',_Pid,Reason} -> print(1, "EXIT, reason ~p", [Reason]); {'EXIT',Reason} -> + report_severe_error(Reason), print(1, "EXIT, reason ~p", [Reason]); _Other -> print(25, "DONE", []) @@ -1448,6 +1441,9 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, "</tfoot>\n", [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). +report_severe_error(Reason) -> + test_server_sup:framework_call(report, [severe_error,Reason]). + %% timer:tc/3 ts_tc(M, F, A) -> Before = ?now, @@ -1881,7 +1877,7 @@ start_log_file() -> {error, eexist} -> ok; MkDirError -> - exit({cant_create_log_dir,{MkDirError,Dir}}) + log_file_error(MkDirError, Dir) end, TestDir = timestamp_filename_get(filename:join(Dir, "run.")), TestDir1 = @@ -1896,10 +1892,10 @@ start_log_file() -> ok -> TestDirX; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDirX}}) + log_file_error(MkDirError2, TestDirX) end; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDir}}) + log_file_error(MkDirError2, TestDir) end, ok = file:write_file(filename:join(Dir, ?last_file), TestDir1 ++ "\n"), ok = file:write_file(?last_file, TestDir1 ++ "\n"), @@ -1926,6 +1922,9 @@ start_log_file() -> test_server_sup:framework_call(report, [loginfo,LogInfo]), {ok,TestDir1}. +log_file_error(Error, Dir) -> + exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}). + make_html_link(LinkName, Target, Explanation) -> %% if possible use a relative reference to Target. TargetL = filename:split(Target), @@ -4687,21 +4686,16 @@ output_to_fd(stdout, Msg, Sender) -> io:format("Testing ~s: ~s\n", [Name, lists:flatten(Msg)]); output_to_fd(undefined, _Msg, _Sender) -> ok; -output_to_fd(Fd, [$=|Msg], internal) -> - io:put_chars(Fd, [$=]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); +output_to_fd(Fd, Msg=[$=|_], internal) -> + io:put_chars(Fd, [Msg,"\n"]); output_to_fd(Fd, Msg, internal) -> - io:put_chars(Fd, [$=,$=,$=,$ ]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); + io:put_chars(Fd, [$=,$=,$=,$ , Msg, "\n"]); output_to_fd(Fd, Msg, _Sender) -> - io:put_chars(Fd, Msg), case get(test_server_log_nl) of - false -> ok; - _ -> io:put_chars(Fd, "\n") + false -> io:put_chars(Fd, Msg); + _ -> io:put_chars(Fd, [Msg,"\n"]) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -5835,11 +5829,11 @@ write_default_cross_coverlog(TestDir) -> {ok,CrossCoverLog} = file:open(filename:join(TestDir,?cross_coverlog_name), [write]), write_coverlog_header(CrossCoverLog), - io:fwrite(CrossCoverLog, - ["No cross cover modules exist for this application,", - xhtml("<br>","<br />"), - "or cross cover analysis is not completed.\n" - "</body></html>\n"], []), + io:put_chars(CrossCoverLog, + ["No cross cover modules exist for this application,", + xhtml("<br>","<br />"), + "or cross cover analysis is not completed.\n" + "</body></html>\n"]), file:close(CrossCoverLog). write_cover_result_table(CoverLog,Coverage) -> diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl index c9c52854e3..b58b42805e 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/test_server/src/test_server_internal.hrl @@ -25,7 +25,7 @@ %% test_server_ctrl:contact_main_target/2 %% Once initiated, this information will never change!! -record(target_info, {where, % local | Socket - os_family, % atom(); win32 | unix | vxworks | ose + os_family, % atom(); win32 | unix os_type, % result of os:type() host, % string(); the name of the target machine version, % string() diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 6358efa764..17c02dfbe5 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -35,7 +35,6 @@ -include("test_server_internal.hrl"). -record(slave_info, {name,socket,client}). --define(VXWORKS_ACCEPT_TIMEOUT,?ACCEPT_TIMEOUT). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% @@ -72,14 +71,6 @@ start_remote_main_target(Parameters) -> lists:foreach(fun(T) -> maybe_reboot_target({TargetType,T}) end, [list_to_atom(TargetHost)|SlaveTargets]), - % Must give the targets a chance to reboot... - case TargetType of - vxworks -> - receive after 15000 -> ok end; - _ -> - ok - end, - Cmd0 = get_main_target_start_command(TargetType,TargetHost,Naming, MasterNode,MasterCookie), Cmd = @@ -462,9 +453,6 @@ start_node_peer(SlaveName, OptList, From, TI) -> %% %% Slave nodes are started on a remote host if %% - the option remote is given when calling test_server:start_node/3 -%% or -%% - the target type is vxworks, since only one erlang node -%% can be started on each vxworks host. %% start_node_slave(SlaveName, OptList, From, TI) -> SuppliedArgs = start_node_get_option_value(args, OptList, []), @@ -787,19 +775,6 @@ kill_node(SI,TI) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Platform specific code -start_target(vxworks,TargetHost,Cmd) -> - case vxworks_client:open(TargetHost) of - {ok,P} -> - case vxworks_client:send_data(P,Cmd,"start_erl called") of - {ok,_} -> - {ok,{vxworks,P},?VXWORKS_ACCEPT_TIMEOUT}; - Error -> - Error - end; - Error -> - Error - end; - start_target(unix,TargetHost,Cmd0) -> Cmd = case test_server_sup:hoststr() of @@ -809,19 +784,9 @@ start_target(unix,TargetHost,Cmd0) -> open_port({spawn, Cmd}, [stream]), {ok,undefined,?ACCEPT_TIMEOUT}. -maybe_reboot_target({vxworks,P}) when is_pid(P) -> - %% Reboot the vxworks card. - %% Client is also closed after this, even if reboot fails - vxworks_client:send_data_wait_for_close(P,"q"); -maybe_reboot_target({vxworks,T}) when is_atom(T) -> - %% Reboot the vxworks card. - %% Client is also closed after this, even if reboot fails - vxworks_client:reboot(T); maybe_reboot_target(_) -> {error, cannot_reboot_target}. -close_target_client({vxworks,P}) -> - vxworks_client:close(P); close_target_client(undefined) -> ok. @@ -830,11 +795,6 @@ close_target_client(undefined) -> %% %% Command for starting main target %% -get_main_target_start_command(vxworks,_TargetHost,Naming, - _MasterNode,_MasterCookie) -> - "e" ++ Naming ++ " test_server -boot start_sasl" - " -sasl errlog_type error" - " -s test_server start " ++ test_server_sup:hoststr(); get_main_target_start_command(unix,_TargetHost,Naming, _MasterNode,_MasterCookie) -> Prog = pick_erl_program(default), @@ -845,9 +805,6 @@ get_main_target_start_command(unix,_TargetHost,Naming, %% %% Command for starting slave nodes %% -get_slave_node_start_command(vxworks, _Prog, _MasterNode) -> - "e"; - %"e-noinput -master " ++ MasterNode; get_slave_node_start_command(unix, Prog, MasterNode) -> cast_to_list(Prog) ++ " -detached -master " ++ MasterNode. diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 9d111ff769..4a27c1ebae 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -473,10 +473,8 @@ getenv_any([]) -> "". %% %% Returns the OS family get_os_family() -> - case os:type() of - {OsFamily,_OsName} -> OsFamily; - OsFamily -> OsFamily - end. + {OsFamily,_OsName} = os:type(), + OsFamily. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 4899f38d2b..db16b6ecd2 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -25,9 +25,9 @@ -module(ts). -export([run/0, run/1, run/2, run/3, run/4, - clean/0, clean/1, tests/0, tests/1, - install/0, install/1, index/0, + install/0, install/1, + bench/0, bench/1, bench/2, benchmarks/0, estone/0, estone/1, cross_cover_analyse/1, compile_testcases/0, compile_testcases/1, @@ -40,20 +40,14 @@ %%% the modules: %%% %%% +-- ts_install --+------ ts_autoconf_win32 -%%% | | -%%% | +------ ts_autoconf_vxworks %%% | %%% ts ---+ +------ ts_erl_config %%% | | ts_lib -%%% | +------ ts_make -%%% | | -%%% +-- ts_run -----+ -%%% | ts_filelib -%%% +------ ts_make_erl -%%% | -%%% +------ ts_reports (indirectly) -%%% -%%% +%%% +-- ts_run -----+------ ts_make +%%% | | ts_filelib +%%% | +------ ts_make_erl +%%% | +%%% +-- ts_benchmark %%% %%% The modules ts_lib and ts_filelib contains utilities used by %%% the other modules. @@ -63,8 +57,7 @@ %%% ts Frontend to the test server framework. Contains all %%% interface functions. %%% ts_install Installs the test suite. On Unix, `autoconf' is -%%% is used; on Windows, ts_autoconf_win32 is used, -%%% on VxWorks, ts_autoconf_vxworks is used. +%%% is used; on Windows, ts_autoconf_win32 is used. %%% The result is written to the file `variables'. %%% ts_run Supervises running of the tests. %%% ts_autconf_win32 An `autoconf' for Windows. @@ -77,10 +70,9 @@ %%% and other platforms. %%% ts_make_erl A corrected version of the standar Erlang module %%% make (used for rebuilding test suites). -%%% ts_reports Generates index pages in HTML, providing a summary -%%% of the tests run. %%% ts_lib Miscellanous utility functions, each used by several %%% other modules. +%%% ts_benchmark Supervises otp benchmarks and collects results. %%%---------------------------------------------------------------------- -include_lib("kernel/include/file.hrl"). @@ -128,7 +120,7 @@ help(installed) -> " ts:run(Spec, Mod) - Run a single test suite.\n", " ts:run(Spec, Mod, Case)\n", " - Run a single test case.\n", - " All above run functions can have the additional Options argument\n", + " All above run functions can have an additional Options argument\n", " which is a list of options.\n", "\n", "Run options supported:\n", @@ -158,13 +150,10 @@ help(installed) -> " {ctp | ctpl, Mod, Func}\n", " {ctp | ctpl, Mod, Func, Arity}\n", "\n", - "Support functions\n", + "Support functions:\n", " ts:tests() - Shows all available families of tests.\n", " ts:tests(Spec) - Shows all available test modules in Spec,\n", " i.e. ../Spec_test/*_SUITE.erl\n", - " ts:index() - Updates local index page.\n", - " ts:clean() - Cleans up all but the last tests run.\n", - " ts:clean(all) - Cleans up all test runs found.\n", " ts:estone() - Run estone_SUITE in kernel application with\n" " no run options\n", " ts:estone(Opts) - Run estone_SUITE in kernel application with\n" @@ -179,6 +168,13 @@ help(installed) -> " - Compile all testcases for usage in a cross ~n" " compile environment." " \n" + "Benchmark functions:\n" + " ts:benchmarks() - Get all available families of benchmarks\n" + " ts:bench() - Runs all benchmarks\n" + " ts:bench(Spec) - Runs all benchmarks in the given spec file.\n" + " The spec file is actually ../*_test/Spec_bench.spec\n\n" + " ts:bench can take the same Options argument as ts:run.\n" + "\n" "Installation (already done):\n" ], show_help([H,?install_help]). @@ -193,33 +189,6 @@ install() -> install(Options) when is_list(Options) -> ts_install:install(install_local,Options). -%% Updates the local index page. - -index() -> - check_and_run(fun(_Vars) -> ts_reports:make_index(), ok end). - -%% -%% clean(all) -%% Deletes all logfiles. -%% -clean(all) -> - delete_files(filelib:wildcard("*" ++ ?logdir_ext)). - -%% clean/0 -%% -%% Cleans up run logfiles, all but the last run. -clean() -> - clean1(filelib:wildcard("*" ++ ?logdir_ext)). - -clean1([Dir|Dirs]) -> - List0 = filelib:wildcard(filename:join(Dir, "run.*")), - case lists:reverse(lists:sort(List0)) of - [] -> ok; - [_Last|Rest] -> delete_files(Rest) - end, - clean1(Dirs); -clean1([]) -> ok. - %% run/0 %% Runs all specs found by ts:tests(), if any, or returns %% {error, no_tests_available}. (batch) @@ -491,6 +460,25 @@ tests(Spec) -> {ok, Cwd} = file:get_cwd(), ts_lib:suites(Cwd, atom_to_list(Spec)). +%% Benchmark related functions + +bench() -> + bench([]). + +bench(Opts) when is_list(Opts) -> + bench(benchmarks(),Opts); +bench(Spec) -> + bench([Spec],[]). + +bench(Spec, Opts) when is_atom(Spec) -> + bench([Spec],Opts); +bench(Specs, Opts) -> + check_and_run(fun(Vars) -> ts_benchmark:run(Specs, Opts, Vars) end). + +benchmarks() -> + ts_benchmark:benchmarks(). + + %% %% estone/0, estone/1 @@ -552,32 +540,6 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - -delete_files([]) -> ok; -delete_files([Item|Rest]) -> - case file:delete(Item) of - ok -> - delete_files(Rest); - {error,eperm} -> - file:change_mode(Item, 8#777), - delete_files(filelib:wildcard(filename:join(Item, "*"))), - file:del_dir(Item), - ok; - {error,eacces} -> - %% We'll see about that! - file:change_mode(Item, 8#777), - case file:delete(Item) of - ok -> ok; - {error,_} -> - erlang:yield(), - file:change_mode(Item, 8#777), - file:delete(Item), - ok - end; - {error,_} -> ok - end, - delete_files(Rest). - %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. diff --git a/lib/test_server/src/ts_autoconf_vxworks.erl b/lib/test_server/src/ts_autoconf_vxworks.erl deleted file mode 100644 index f4535cd89a..0000000000 --- a/lib/test_server/src/ts_autoconf_vxworks.erl +++ /dev/null @@ -1,191 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. 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% -%% - -%%% Purpose : Autoconf for cross environments. - --module(ts_autoconf_vxworks). --export([configure/1]). -%%% Supported cross platforms: --define(PLATFORMS, ["vxworks_cpu32", "vxworks_ppc860", "vxworks_ppc603", - "vxworks_sparc", "vxworks_ppc750", "vxworks_simso"]). --include("ts.hrl"). - -%% takes an argument {Target_arch, Target_host} (e.g. {vxworks_ppc860, thorin}). -configure({Target_arch, Target_host}) -> - case variables({Target_arch, Target_host}) of - {ok, Vars} -> - ts_lib:subst_file("conf_vars.in", "conf_vars", Vars); - Error -> - Error - end. - -variables(Cross_spec) -> - run_tests(Cross_spec, tests(), []). - -run_tests(Cross_spec, [{Prompt, Tester}|Rest], Vars) -> - io:format("checking ~s... ", [Prompt]), - case catch Tester(Cross_spec, Vars) of - {'EXIT', Reason} -> - io:format("FAILED~nExit status: ~p~n", [Reason]), - {error, auto_conf_failed}; - {Result, NewVars} -> - io:format("~s~n", [lists:concat([Result])]), - run_tests(Cross_spec, Rest, NewVars) - end; -run_tests(_Cross_spec, [], Vars) -> - {ok, Vars}. - - -%%% The tests. - -tests() -> - [{"supported target architecture", fun target_architecture/2}, - {"cross target host to run tests on", fun target_host/2}, - {"CPU type", fun cpu/2}, - {"for cross-compiling gcc", fun find_gcc/2}, - {"for cross-linker", fun find_ld/2}, - {"for object extension", fun find_obj/2}, - {"for shared libraries extension", fun find_dll/2}, - {"for executables extension", fun find_exe/2}, - {"for make", fun find_make/2}]. - -target_architecture({Architecture, _Target_host}, Vars) -> - case lists:member(Architecture, ?PLATFORMS) of - true -> - {Architecture, [{host_os, os_type(Architecture)}, {host, Architecture}|Vars]}; - false -> - {"unsupported_platform", Vars} - end. - -target_host({_Architecture, Target_host}, Vars) -> - {Target_host, [{target_host, Target_host} | Vars]}. - -cpu({Arch, _Target_host}, Vars) -> - Cpu = processor(Arch), - {Cpu, [{host_cpu, Cpu}|Vars]}. - -find_gcc({Arch, _Target_host}, Vars) -> - Gcc = "cc" ++ gnu_suffix(Arch), - case os:find_executable(Gcc) of - false -> - {no, Vars}; - Path when is_list(Path) -> - Cflags = cflags(Arch), - {Path, [{'CC', Gcc}, - {'CFLAGS', Cflags}, - {'EI_CFLAGS', Cflags}, - {'ERTS_CFLAGS', Cflags}, - {'DEFS', ""}, - {'ERTS_LIBS', ""}, - {'LIBS', ""}, - {'SHLIB_CFLAGS', Cflags}, - {test_c_compiler, "{gnuc, undefined}"} | Vars]} - end. - -find_ld({Arch, _Target_host}, Vars) -> - Linker = "ld" ++ gnu_suffix(Arch), - case os:find_executable(Linker) of - false -> - {no, Vars}; - Path when is_list(Path) -> - {Path, [{'LD', Linker}, - {'CROSSLDFLAGS', ldflags(Arch)}, - {'SHLIB_EXTRACT_ALL', ""}, - {'SHLIB_LD', Linker}, - {'SHLIB_LDFLAGS', ""}, - {'SHLIB_LDLIBS', ""} | Vars]} - end. - -find_obj({Arch, _Target_host}, Vars) -> - Obj = obj_ext(Arch), - {Obj, [{obj, Obj}|Vars]}. - -find_dll({Arch, _Target_host}, Vars) -> - Dll = dll_ext(Arch), - {Dll, [{'SHLIB_SUFFIX', Dll}|Vars]}. - -find_exe({Arch, _Target_host}, Vars) -> - Exe = exe_ext(Arch), - {Exe, [{exe, Exe}|Vars]}. - -find_make(_, Vars) -> - {"make", [{make_command, "make"} | Vars]}. - -%%% some utility functions -gnu_suffix(Arch) -> - {_, _, _, _, Suffix, _Cpu, _Cflags, _} = cross_data(Arch), - Suffix. - -processor(Arch) -> - {_, _, _, _, _Suffix, Cpu, _Cflags, _} = cross_data(Arch), - Cpu. - -cflags(Arch) -> - {_, _, _, _, _Suffix, _Cpu, Cflags, _} = cross_data(Arch), - Cflags. - -ldflags(Arch) -> - {_, _, _, _, _Suffix, _Cpu, _Cflags, Ldflags} = cross_data(Arch), - Ldflags. - -os_type(Arch) -> - {Os_type, _, _, _, _, _, _, _} = cross_data(Arch), - Os_type. - -obj_ext(Arch) -> - {_, _, Obj, _, _, _, _, _} = cross_data(Arch), - Obj. - -dll_ext(Arch) -> - {_, _, _, Dll, _, _, _, _} = cross_data(Arch), - Dll. - -exe_ext(Arch) -> - {_, Exe, _, _, _, _, _, _} = cross_data(Arch), - Exe. - -cross_data(Arch) -> - case Arch of - "vxworks_cpu32" -> - {"VxWorks", "", ".o", ".eld", "68k", "cpu32", - "-DCPU=CPU32 -DVXWORKS -I$(WIND_BASE)/target/h -mnobitfield -fno-builtin -nostdinc -fvolatile -msoft-float", - "-r -d"}; - "vxworks_ppc860" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc860", - "-DCPU=PPC860 -DVXWORKS -I$(WIND_BASE)/target/h -mcpu=860 -fno-builtin -fno-for-scope -msoft-float -D_GNU_TOOL -nostdinc", - "-r -d"}; - "vxworks_ppc603" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc603", - "-DCPU=PPC603 -DVXWORKS -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL -nostdinc", - "-r -d"}; - "vxworks_sparc" -> - %%% The Sparc Architecture is included for private use (i.e. not Tornado 1.0.1 compatible). - {"VxWorks", "", ".o", ".eld", "sparc", "sparc", - "-DCPU=SPARC -DVXWORKS -I/home/gandalf/bsproj/BS.2/UOS/vw/5.2/h -fno-builtin -nostdinc", - "-r -d"}; - "vxworks_ppc750" -> - {"VxWorks", "", ".o", ".eld", "ppc", "ppc604", - "-DCPU=PPC604 -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -fno-builtin -fno-for-scope -D_GNU_TOOL", - "-r -d"}; - "vxworks_simso" -> - {"VxWorks", "", ".o", ".eld", "simso", "simso", - "-DCPU=SIMSPARCSOLARIS -DVXWORKS -DTOOL_FAMILY=gnu -DTOOL=gnu -I$(WIND_BASE)/target/h -I$(WIND_GCC_INCLUDE) -fno-builtin -fno-for-scope -D_GNU_TOOL", - "-r -d"} - - end. diff --git a/lib/test_server/src/ts_benchmark.erl b/lib/test_server/src/ts_benchmark.erl new file mode 100644 index 0000000000..516d22fd2d --- /dev/null +++ b/lib/test_server/src/ts_benchmark.erl @@ -0,0 +1,91 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2012. 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% +%% +-module(ts_benchmark). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("kernel/include/file.hrl"). +-include("ts.hrl"). + +-export([benchmarks/0, + run/3]). + +%% gen_event callbacks +-export([init/1, handle_event/2]). + +benchmarks() -> + {ok, Cwd} = file:get_cwd(), + Benches = filelib:wildcard( + filename:join([Cwd,"..","*_test","*_bench.spec"])), + [begin + Base = filename:basename(N), + list_to_atom(string:substr(Base,1,string:rstr(Base,"_")-1)) + end || N <- Benches]. + +run(Specs, Opts, Vars) -> + {ok, Cwd} = file:get_cwd(), + {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(), + BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]), + BDir = filename:join([Cwd,BName]), + file:make_dir(BDir), + [ts_run:run(atom_to_list(Spec), + [{spec, [atom_to_list(Spec)++"_bench.spec"]}], + [{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars) + || Spec <- Specs], + file:delete(filename:join(Cwd,"latest_benchmark")), + {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]), + io:format(D,BDir,[]), + file:close(D). + + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +-record(state, { spec, suite, tc, stats_dir}). + +init([Spec,Dir]) -> + {ok, #state{ spec = Spec, stats_dir = Dir }}. + +handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) -> + {ok,State#state{ suite = Suite, tc = Tc}}; +handle_event(#event{name = benchmark_data, data = Data}, State) -> + Spec = proplists:get_value(application, Data, State#state.spec), + Suite = proplists:get_value(suite, Data, State#state.suite), + Tc = proplists:get_value(name, Data, State#state.tc), + Value = proplists:get_value(value, Data), + {ok, D} = file:open(filename:join( + [State#state.stats_dir, + lists:concat([e(Spec),"-",e(Suite),"-", + e(Tc),".ebench"])]), + [append]), + io:format(D, "~p~n",[Value]), + file:close(D), + {ok, State}; +handle_event(_Event, State) -> + {ok, State}. + + +e(Atom) when is_atom(Atom) -> + Atom; +e(Str) when is_list(Str) -> + lists:map(fun($/) -> + $\\; + (C) -> + C + end,Str). diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index 43e56e1098..73abe86e11 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -160,7 +160,6 @@ system_include(Root, Vars) -> SysDir = case ts_lib:var(os, Vars) of "Windows" ++ _T -> "sys/win32"; - "VxWorks" -> "sys.vxworks"; _ -> "sys/unix" end, " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))). @@ -176,9 +175,6 @@ erl_interface(Vars,OsType) -> {installed, _Root} -> {filename:join(Dir, "lib"), filename:join(Dir, "src")}; - {srctree, _Root, _Target} when OsType =:= vxworks -> - {filename:join(Dir, "lib"), - filename:join([Dir, "src"])}; {srctree, _Root, Target} -> {filename:join([Dir, "obj", Target]), filename:join([Dir, "src", Target])} @@ -218,7 +214,7 @@ erl_interface(Vars,OsType) -> {unix,_} -> "-lpthread"; _ -> - "" % VxWorks + "" end, [{erl_interface_libpath, quote(filename:nativename(LibPath))}, {erl_interface_sock_libs, sock_libraries(OsType)}, @@ -318,16 +314,12 @@ get_var(Key, Vars) -> sock_libraries({win32, _}) -> "ws2_32.lib"; sock_libraries({unix, _}) -> - ""; % Included in general libraries if needed. -sock_libraries(vxworks) -> - "". + "". % Included in general libraries if needed. link_library(LibName,{win32, _}) -> LibName ++ ".lib"; link_library(LibName,{unix, _}) -> "lib" ++ LibName ++ ".a"; -link_library(LibName,vxworks) -> - "lib" ++ LibName ++ ".a"; link_library(_LibName,_Other) -> exit({link_library, not_supported}). diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index caf00759e5..ba8952f10f 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -55,8 +55,7 @@ build_install(TargetSystem, Options) -> end. os_type({unix,_}=OsType) -> OsType; -os_type({win32,_}=OsType) -> OsType; -os_type(_Other) -> vxworks. +os_type({win32,_}=OsType) -> OsType. target_install(CrossVars) -> io:format("Cross installation detected, skipping configure and data_dir make~n"), @@ -76,7 +75,6 @@ target_install(CrossVars) -> %% Autoconf for various platforms. %% unix uses the configure script %% win32 uses ts_autoconf_win32 -%% VxWorks uses ts_autoconf_vxworks. autoconf(TargetSystem, XComp) -> case autoconf1(TargetSystem, XComp) of @@ -90,8 +88,6 @@ autoconf1({win32, _},[{cross,"no"}]) -> ts_autoconf_win32:configure(); autoconf1({unix, _},XCompFile) -> unix_autoconf(XCompFile); -autoconf1(Other,[{cross,"no"}]) -> - ts_autoconf_vxworks:configure(Other); autoconf1(_,_) -> io:format("cross compilation not supported for that this platform~n"), throw(cross_installation_failed). diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index ea97361bd3..d9a699ca9f 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -25,9 +25,8 @@ -compile({no_auto_import,[error/1]}). -export([error/1, var/2, erlang_type/0, erlang_type/1, - initial_capital/1, interesting_logs/1, - specs/1, suites/2, last_test/1, - force_write_file/2, force_delete/1, + initial_capital/1, + specs/1, suites/2, subst_file/3, subst/2, print_data/1, make_non_erlang/2, maybe_atom_to_list/1, progress/4 @@ -91,25 +90,18 @@ initial_capital([C|Rest]) when $a =< C, C =< $z -> initial_capital(String) -> String. -%% Returns a list of the "interesting logs" in a directory, -%% i.e. those that correspond to spec files. - -interesting_logs(Dir) -> - Logs = filelib:wildcard(filename:join(Dir, [$*|?logdir_ext])), - Interesting = - case specs(Dir) of - [] -> - Logs; - Specs0 -> - Specs = ordsets:from_list(Specs0), - [L || L <- Logs, ordsets:is_element(filename_to_atom(L), Specs)] - end, - sort_tests(Interesting). - specs(Dir) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), - "*_test", "*.{dyn,}spec"])), - sort_tests([filename_to_atom(Name) || Name <- Specs]). + "*_test", "*.{dyn,}spec"])), + % Filter away all spec which end with _bench.spec + NoBench = fun(SpecName) -> + case lists:reverse(SpecName) of + "ceps.hcneb_"++_ -> false; + _ -> true + end + end, + + sort_tests([filename_to_atom(Name) || Name <- Specs, NoBench(Name)]). suites(Dir, Spec) -> Glob=filename:join([filename:dirname(Dir), Spec++"_test", @@ -157,42 +149,6 @@ suite_order(mnesia) -> 44; suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last! suite_order(_) -> 200. -last_test(Dir) -> - last_test(filelib:wildcard(filename:join(Dir, "run.[1-2]*")), false). - -last_test([Run|Rest], false) -> - last_test(Rest, Run); -last_test([Run|Rest], Latest) when Run > Latest -> - last_test(Rest, Run); -last_test([_|Rest], Latest) -> - last_test(Rest, Latest); -last_test([], Latest) -> - Latest. - -%% Do the utmost to ensure that the file is written, by deleting or -%% renaming an old file with the same name. - -force_write_file(Name, Contents) -> - force_delete(Name), - file:write_file(Name, Contents). - -force_delete(Name) -> - case file:delete(Name) of - {error, eacces} -> - force_rename(Name, Name ++ ".old.", 0); - Other -> - Other - end. - -force_rename(From, To, Number) -> - Dest = [To|integer_to_list(Number)], - case file:read_file_info(Dest) of - {ok, _} -> - force_rename(From, To, Number+1); - {error, _} -> - file:rename(From, Dest) - end. - %% Substitute all occurrences of @var@ in the In file, using %% the list of variables in Vars, producing the output file Out. %% Returns: ok | {error, Reason} diff --git a/lib/test_server/src/ts_reports.erl b/lib/test_server/src/ts_reports.erl deleted file mode 100644 index f981a77ae4..0000000000 --- a/lib/test_server/src/ts_reports.erl +++ /dev/null @@ -1,545 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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% -%% - -%%% Purpose : Produces reports in HTML from the outcome of test suite runs. - --module(ts_reports). - --export([make_index/0, make_master_index/2, make_progress_index/2]). --export([count_cases/1, year/0, current_time/0]). - --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - --compile({no_auto_import,[error/1]}). - --import(filename, [basename/1, rootname/1]). --import(ts_lib, [error/1]). - - -%% Make master index page which points out index pages for all platforms. - -make_master_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - {ok, Index0} = make_master_index1(directories(Dir), master_header(Vars)), - Index = [Index0|master_footer()], - io:put_chars("Updating " ++ IndexName ++ "... "), - ok = ts_lib:force_write_file(IndexName, Index), - io:put_chars("done\n"). - -make_master_index1([Dir|Rest], Result) -> - NewResult = - case catch read_variables(Dir) of - {'EXIT',{{bad_installation,Reason},_}} -> - io:put_chars("Failed to read " ++ filename:join(Dir,?variables)++ - ": " ++ Reason ++ " - Ignoring this directory\n"), - Result; - Vars -> - Platform = ts_lib:var(platform_label, Vars), - case make_index(Dir, Vars, false) of - {ok, Summary} -> - make_master_index(Platform, Dir, Summary, Result); - {error, _} -> - Result - end - end, - make_master_index1(Rest, NewResult); -make_master_index1([], Result) -> - {ok, Result}. - -make_progress_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - io:put_chars("Updating " ++ IndexName ++ "... "), - Index0=progress_header(Vars), - ts_lib:force_delete(IndexName), - Dirs=find_progress_runs(Dir), - Index1=[Index0|make_progress_links(Dirs, [])], - IndexF=[Index1|progress_footer()], - ok = ts_lib:force_write_file(IndexName, IndexF), - io:put_chars("done\n"). - -find_progress_runs(Dir) -> - case file:list_dir(Dir) of - {ok, Dirs0} -> - Dirs1= [filename:join(Dir,X) || X <- Dirs0, - filelib:is_dir(filename:join(Dir,X))], - lists:sort(Dirs1); - _ -> - [] - end. - -name_from_vars(Dir, Platform) -> - VarFile=filename:join([Dir, Platform, "variables"]), - case file:consult(VarFile) of - {ok, Vars} -> - ts_lib:var(platform_id, Vars); - _Other -> - Platform - end. - -make_progress_links([], Acc) -> - Acc; -make_progress_links([RDir|Rest], Acc) -> - Dir=filename:basename(RDir), - Platforms=[filename:basename(X) || - X <- find_progress_runs(RDir)], - PlatformLinks=["<A HREF=\""++filename:join([Dir,X,"index.html"]) - ++"\">"++name_from_vars(RDir, X)++"</A><BR>" || - X <- Platforms], - LinkName=Dir++"/index.html", - Link = - [ - "<TR valign=top>\n", - "<TD><A HREF=\"", LinkName, "\">", Dir, "</A></TD>", "\n", - "<TD>", PlatformLinks, "</TD>", "\n" - ], - make_progress_links(Rest, [Link|Acc]). - -read_variables(Dir) -> - case file:consult(filename:join(Dir, ?variables)) of - {ok, Vars} -> Vars; - {error, Reason} -> - erlang:error({bad_installation,file:format_error(Reason)}, [Dir]) - end. - -make_master_index(Platform, Dirname, {Succ, Fail, UserSkip,AutoSkip}, Result) -> - Link = filename:join(filename:basename(Dirname), "index.html"), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - [Result, - "<TR valign=top>\n", - "<TD><A HREF=\"", Link, "\">", Platform, "</A></TD>", "\n", - make_row(integer_to_list(Succ), false), - make_row(FailStr, false), - make_row(integer_to_list(UserSkip), false), - make_row(AutoSkipStr, false), - "</TR>\n"]. - -%% Make index page which points out individual test suites for a single platform. - -make_index() -> - {ok, Pwd} = file:get_cwd(), - Vars = read_variables(Pwd), - make_index(Pwd, Vars, true). - -make_index(Dir, Vars, IncludeLast) -> - IndexName = filename:absname("index.html", Dir), - io:put_chars("Updating " ++ IndexName ++ "... "), - case catch make_index1(Dir, IndexName, Vars, IncludeLast) of - {'EXIT', Reason} -> - io:put_chars("CRASHED!\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {error, Reason} -> - io:put_chars("FAILED\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {ok, Summary} -> - io:put_chars("done\n"), - {ok, Summary}; - Err -> - io:format("Unknown internal error. Please report.\n(Err: ~p, ID: 1)", - [Err]), - {error, Err} - end. - -make_index1(Dir, IndexName, Vars, IncludeLast) -> - Logs0 = ts_lib:interesting_logs(Dir), - Logs = - case IncludeLast of - true -> add_last_name(Logs0); - false -> Logs0 - end, - {ok, {Index0, Summary}} = make_index(Logs, header(Vars), 0, 0, 0, 0, 0), - Index = [Index0|footer()], - case ts_lib:force_write_file(IndexName, Index) of - ok -> - {ok, Summary}; - {error, Reason} -> - error({index_write_error, Reason}) - end. - -make_index([Name|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - case ts_lib:last_test(Name) of - false -> - %% Silently skip. - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt); - Last -> - case count_cases(Last) of - {Succ, Fail, USkip, ASkip} -> - Cov = - case file:read_file(filename:join(Last,?cover_total)) of - {ok,Bin} -> - TotCoverage = binary_to_term(Bin), - io_lib:format("~w %",[TotCoverage]); - _error -> - "" - end, - Link = filename:join(basename(Name), basename(Last)), - JustTheName = rootname(basename(Name)), - NotBuilt = not_built(JustTheName), - NewResult = [Result, make_index1(JustTheName, - Link, Succ, Fail, USkip, ASkip, - NotBuilt, Cov, false)], - make_index(Rest, NewResult, TotSucc+Succ, TotFail+Fail, - UserSkip+USkip, AutoSkip+ASkip, TotNotBuilt+NotBuilt); - error -> - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt) - end - end; -make_index([], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - {ok, {[Result|make_index1("Total", no_link, - TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt, "", true)], - {TotSucc, TotFail, UserSkip, AutoSkip}}}. - -make_index1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, NotBuilt, Coverage, Bold) -> - Name = test_suite_name(SuiteName), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - ["<TR valign=top>\n", - "<TD>", - case Link of - no_link -> - ["<B>", Name|"</B>"]; - _Other -> - CrashDumpName = SuiteName ++ "_erl_crash.dump", - CrashDumpLink = - case filelib:is_file(CrashDumpName) of - true -> - [" <A HREF=\"", CrashDumpName, - "\">(CrashDump)</A>"]; - false -> - "" - end, - LogFile = filename:join(Link, ?suitelog_name ++ ".html"), - ["<A HREF=\"", LogFile, "\">", Name, "</A>\n", CrashDumpLink, - "</TD>\n"] - end, - make_row(integer_to_list(Success), Bold), - make_row(FailStr, Bold), - make_row(integer_to_list(UserSkip), Bold), - make_row(AutoSkipStr, Bold), - make_row(integer_to_list(NotBuilt), Bold), - make_row(Coverage, Bold), - "</TR>\n"]. - -make_row(Row, true) -> - ["<TD ALIGN=right><B>", Row|"</B></TD>"]; -make_row(Row, false) -> - ["<TD ALIGN=right>", Row|"</TD>"]. - -not_built(BaseName) -> - Dir = filename:join("..", BaseName++"_test"), - Erl = length(filelib:wildcard(filename:join(Dir,"*_SUITE.erl"))), - Beam = length(filelib:wildcard(filename:join(Dir,"*_SUITE.beam"))), - Erl-Beam. - - -%% Add the log file directory for the very last test run (according to -%% last_name). - -add_last_name(Logs) -> - case file:read_file("last_name") of - {ok, Bin} -> - Name = filename:dirname(lib:nonl(binary_to_list(Bin))), - case lists:member(Name, Logs) of - true -> Logs; - false -> [Name|Logs] - end; - _ -> - Logs - end. - -term_to_text(Term) -> - lists:flatten(io_lib:format("~p.\n", [Term])). - -test_suite_name(Name) -> - ts_lib:initial_capital(Name) ++ " suite". - -directories(Dir) -> - {ok, Files} = file:list_dir(Dir), - [filename:join(Dir, X) || X <- Files, - filelib:is_dir(filename:join(Dir, X))]. - - -%%% Headers and footers. - -header(Vars) -> - Platform = ts_lib:var(platform_id, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>Test Results for ", Platform, "</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>Test Results for ", Platform, "</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><B>Family</B></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "<th>Missing Suites</th>\n" - "<th>Coverage</th>\n" - "\n"]. - -footer() -> - ["</TABLE>\n" - "</CENTER>\n" - "<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" - "</body>\n" - "</HTML>\n"]. - -progress_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Progress Test Results</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Progress Test Results</H1>\n", - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Test Run</b></th><th>Platforms</th>\n"]. - -progress_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -master_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - Vsn = erlang:system_info(version), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Test Results (", Vsn, ")</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Test Results (", Vsn, ")</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Platform</b></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "\n"]. - -master_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">". - -year() -> - {Y, _, _} = date(), - integer_to_list(Y). - -current_time() -> - {{Y, Mon, D}, {H, Min, S}} = calendar:local_time(), - Weekday = weekday(calendar:day_of_the_week(Y, Mon, D)), - lists:flatten(io_lib:format("~s ~s ~p ~2.2.0w:~2.2.0w:~2.2.0w ~w", - [Weekday, month(Mon), D, H, Min, S, Y])). - -weekday(1) -> "Mon"; -weekday(2) -> "Tue"; -weekday(3) -> "Wed"; -weekday(4) -> "Thu"; -weekday(5) -> "Fri"; -weekday(6) -> "Sat"; -weekday(7) -> "Sun". - -month(1) -> "Jan"; -month(2) -> "Feb"; -month(3) -> "Mar"; -month(4) -> "Apr"; -month(5) -> "May"; -month(6) -> "Jun"; -month(7) -> "Jul"; -month(8) -> "Aug"; -month(9) -> "Sep"; -month(10) -> "Oct"; -month(11) -> "Nov"; -month(12) -> "Dec". - -%% Count test cases in the given directory (a directory of the type -%% run.1997-08-04_09.58.52). - -count_cases(Dir) -> - SumFile = filename:join(Dir, ?run_summary), - case read_summary(SumFile, [summary]) of - {ok, [{Succ,Fail,Skip}]} -> - {Succ,Fail,Skip,0}; - {ok, [Summary]} -> - Summary; - {error, _} -> - LogFile = filename:join(Dir, ?suitelog_name), - case file:read_file(LogFile) of - {ok, Bin} -> - Summary = count_cases1(binary_to_list(Bin), {0, 0, 0, 0}), - write_summary(SumFile, Summary), - Summary; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), - error - end - end. - -write_summary(Name, Summary) -> - File = [term_to_text({summary, Summary})], - ts_lib:force_write_file(Name, File). - -% XXX: This function doesn't do what the writer expect. It can't handle -% the case if there are several different keys and I had to add a special -% case for the empty file. The caller also expect just one tuple as -% a result so this function is written way to general for no reason. -% But it works sort of. /kgb - -read_summary(Name, Keys) -> - case file:consult(Name) of - {ok, []} -> - {error, "Empty summary file"}; - {ok, Terms} -> - {ok, lists:map(fun(Key) -> {value, {_, Value}} = - lists:keysearch(Key, 1, Terms), - Value end, - Keys)}; - {error, Reason} -> - {error, Reason} - end. - -count_cases1("=failed" ++ Rest, {Success, _Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Count, UserSkip,AutoSkip}); -count_cases1("=successful" ++ Rest, {_Success, Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Count, Fail, UserSkip,AutoSkip}); -count_cases1("=skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=user_skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=auto_skipped" ++ Rest, {Success, Fail, UserSkip,_AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, UserSkip,Count}); -count_cases1([], Counters) -> - Counters; -count_cases1(Other, Counters) -> - count_cases1(skip_to_nl(Other), Counters). - -get_number([$\s|Rest]) -> - get_number(Rest); -get_number([Digit|Rest]) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Digit-$0). - -get_number([Digit|Rest], Acc) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Acc*10+Digit-$0); -get_number([$\n|Rest], Acc) -> - {Rest, Acc}; -get_number([_|Rest], Acc) -> - get_number(Rest, Acc). - -skip_to_nl([$\n|Rest]) -> - Rest; -skip_to_nl([_|Rest]) -> - skip_to_nl(Rest); -skip_to_nl([]) -> - []. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 95e3c08d5b..f4d5b3e3b1 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -21,7 +21,7 @@ -module(ts_run). --export([run/4]). +-export([run/4,ct_run_test/2]). -define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60). -define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15). @@ -87,6 +87,24 @@ execute([Hook|Rest], Vars0, Spec0, St0) -> execute([], Vars, Spec, St) -> {ok, Vars, Spec, St}. +%% Wrapper to run tests using ct:run_test/1 and handle any errors. + +ct_run_test(Dir, CommonTestArgs) -> + try + ok = file:set_cwd(Dir), + case ct:run_test(CommonTestArgs) of + {_,_,_} -> + ok; + {error,Error} -> + io:format("ERROR: ~P\n", [Error,20]); + Other -> + io:format("~P\n", [Other,20]) + end + catch + _:Crash -> + io:format("CRASH: ~P\n", [Crash,20]) + end. + %% %% Deletes File from Files when File is on the form .../<SUITE>_data/<file> %% when all of <SUITE> has been skipped in Spec, i.e. there @@ -157,7 +175,6 @@ get_config_files() -> [TSConfig | case os:type() of {unix,_} -> ["ts.unix.config"]; {win32,_} -> ["ts.win32.config"]; - vxworks -> ["ts.vxworks.config"]; _ -> [] end]. @@ -231,8 +248,7 @@ make_command(Vars, Spec, State) -> " -boot start_sasl -sasl errlog_type error", " -pz \"",Cwd,"\"", " -ct_test_vars ",TestVars, - " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " - " -eval \"ct:run_test(", + " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ", backslashify(lists:flatten(State#state.test_server_args)),")\"" " ", ExtraArgs], @@ -329,8 +345,7 @@ start_xterm(Command) -> path_separator() -> case os:type() of {win32, _} -> ";"; - {unix, _} -> ":"; - vxworks -> ":" + {unix, _} -> ":" end. diff --git a/lib/test_server/src/ts_selftest.erl b/lib/test_server/src/ts_selftest.erl deleted file mode 100644 index 655aa4bab3..0000000000 --- a/lib/test_server/src/ts_selftest.erl +++ /dev/null @@ -1,120 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. 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% -%% --module(ts_selftest). --export([selftest/0]). - -selftest() -> - case node() of - nonode@nohost -> - io:format("Sorry, you have to start this node distributed.~n"), - exit({error, node_not_distributed}); - _ -> - ok - end, - case catch ts:tests(test_server) of - {'EXIT', _} -> - io:format("Test Server self test not availiable."); - Other -> - selftest1() - end. - -selftest1() -> - % Batch starts - io:format("Selftest #1: Whole spec, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, [batch]), - ok=check_result(1, "test_server.logs", 2), - - io:format("Selftest #2: One module, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, test_server_SUITE, [batch]), - ok=check_result(2, "test_server_SUITE.logs", 2), - - io:format("Selftest #3: One testcase, batch mode:~n"), - io:format("--------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs, [batch]), - ok=check_result(3, "test_server_SUITE.logs", 0), - - % Interactive starts - io:format("Selftest #4: Whole spec, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server), - kill_test_server(), - ok=check_result(4, "test_server.logs", 2), - - io:format("Selftest #5: One module, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server, test_server_SUITE), - kill_test_server(), - ok=check_result(5, "test_server_SUITE.logs", 2), - - io:format("Selftest #6: One testcase, interactive mode:~n"), - io:format("--------------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs), - kill_test_server(), - ok=check_result(6, "test_server_SUITE.logs", 0), - - ok. - -check_result(Test, TDir, ExpSkip) -> - Dir=ts_lib:last_test(TDir), - {Total, Failed, Skipped}=ts_reports:count_cases(Dir), - io:format("Selftest #~p:",[Test]), - case {Total, Failed, Skipped} of - {_, 0, ExpSkip} -> % 2 test cases should be skipped. - io:format("All ok.~n~n"), - ok; - {_, _, _} -> - io:format("Not completely successful.~n~n"), - error - end. - - -%% Wait for test server to get started. -kill_test_server() -> - Node=list_to_atom("test_server@"++atom_to_list(hostname())), - net_adm:ping(Node), - case whereis(test_server_ctrl) of - undefined -> - kill_test_server(); - Pid -> - kill_test_server(0, Pid) - end. - -%% Wait for test server to finish. -kill_test_server(30, Pid) -> - exit(self(), test_server_is_dead); -kill_test_server(Num, Pid) -> - case whereis(test_server_ctrl) of - undefined -> - slave:stop(node(Pid)); - Pid -> - receive - after - 1000 -> - kill_test_server(Num+1, Pid) - end - end. - - -hostname() -> - list_to_atom(from($@, atom_to_list(node()))). -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(H, []) -> []. diff --git a/lib/test_server/src/vxworks_client.erl b/lib/test_server/src/vxworks_client.erl deleted file mode 100644 index ca65eca02a..0000000000 --- a/lib/test_server/src/vxworks_client.erl +++ /dev/null @@ -1,243 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. 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% -%% --module(vxworks_client). - --export([open/1, close/1, send_data/2, send_data/3, send_data_wait_for_close/2, reboot/1]). --export([init/2]). - --include("ts.hrl"). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% This is a client talking to a test server daemon on a VxWorks card. -%%% -%%% User interface: -%%% -%%% open/1 -%%% Start a client and establish the connection with the test server daemon -%%% -%%% send_data/2 -%%% Send data/command to the test server daemon, don't wait for any return -%%% -%%% send_data/3 -%%% Send data/command to the test server daemon and wait for the given -%%% return value. -%%% -%%% send_data_wait_for_close/2 -%%% Send data/command to the test server daemon and wait for the daemon to -%%% close the connection. -%%% -%%% close/1 -%%% Close the client. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -%% -%% User interface -%% - -reboot(Target) -> - {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target), - Fun = fun({ok, Socket}) -> - gen_tcp:send(Socket, "q\n"), - receive - {tcp_closed, Socket} -> - gen_tcp:close(Socket), - {ok, socket_closed} - after 5000 -> - exit({timeout, tryagain}) - end - end, - io:format("Stopping (rebooting) ~p ",[Target]), - case fun_target(Addr, Fun) of - {ok, socket_closed} -> - ok; - _Else -> - io:format("No contact with ts daemon - exiting ...~n"), - exit({stop, no_ts_daemon_contact}) - end. - - -%% open(Target) -> {ok,Client} | {error, Reason} -open(Target) -> - {ok, {_,_,_,_,_,[Addr|_]}} = inet:gethostbyname(Target), - Fun = fun({ok, Socket}) -> - P = spawn(?MODULE,init,[Target,Socket]), - inet_tcp:controlling_process(Socket,P), - {ok,P} - end, - case fun_target(Addr,Fun) of - {ok, Pid} -> - {ok, Pid}; - {error,Reason} -> - {error, Reason} - end. - -%% send_data(Client,Data) -> ok -send_data(Pid,Data) -> - Pid ! {send_data,Data++"\n"}, - ok. - -%% send_data(Client,Data,ExpectedReturn) -> {ok,ExpectedReturn} | {error,Reason} -send_data(Pid,Data,Return) -> - Pid ! {send_data,Data++"\n",Return,self()}, - receive {Pid,Result} -> Result end. - -%% send_data_wait_for_close(Client,Data) -> ok | {error,Reason} -send_data_wait_for_close(Pid,Data) -> - send_data(Pid,Data,tcp_closed). - -%% close(Client) -> ok -close(Pid) -> - Pid ! close, - ok. - - -%% -%% Internal -%% - -init(Target,Socket) -> - process_flag(trap_exit,true), - loop(Target,Socket). - -loop(Target,Socket) -> - receive - {send_data,Data} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - loop(Socket,Target); - {send_data,Data,tcp_closed,From} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - receive - {tcp_closed, Socket} -> - From ! {self(),ok} - after 5000 -> - From ! {self(),{error,timeout}} - end, - closed(Socket,normal); - {send_data,Data,Return,From} -> - %% io:format("vx client sending: ~p~n", [Data]), - gen_tcp:send(Socket, Data), - case receive_line(Socket,[],Return,200) of - {tcp_closed, Socket} -> - From ! {self(),{error,{socket_closed,Target}}}, - closed(Socket,{socket_closed,Target}); - {tcp,Socket,_Rest} -> - From ! {self(),{ok,Data}}, - got_data(Target,Socket,Data); - error -> - From ! {self(),{error,{catatonic,Target}}} - end; - close -> - closed(Socket,normal); - {tcp_closed, Socket} -> - closed(Socket,{socket_closed,Target}); - {tcp,Socket,Data} -> - got_data(Target,Socket,Data) - end. - - - -closed(Socket,Reason) -> - gen_tcp:close(Socket), - exit(Reason). - -got_data(Target,Socket,Data) -> - if is_atom(Target) -> - io:format("~w: ~s",[Target,uncr(Data)]); - true -> - io:format("~s: ~s",[Target,uncr(Data)]) - end, - loop(Target,Socket). - -uncr([]) -> - []; -uncr([$\r | T]) -> - uncr(T); -uncr([H | T]) -> - [H | uncr(T)]. - -strip_line(Line) -> - RPos = string:rchr(Line, $\n), - string:substr(Line,RPos+1). - -maybe_done_receive(Socket,Ack,Match,C) -> - case string:str(Ack,Match) of - 0 -> - receive_line(Socket,strip_line(Ack),Match,C); - _ -> - {tcp,Socket,strip_line(Ack)} - end. - - -receive_line(_Socket,_Ack,_Match,0) -> - error; -receive_line(Socket,Ack,Match,Counter) -> - receive - {tcp_closed, Socket} -> - {tcp_closed, Socket}; - {tcp,Socket,Data} -> - NewAck = Ack ++ Data, - case {string:str(NewAck,"\r") > 0, - string:str(NewAck,"\n") > 0} of - {true,_} -> - maybe_done_receive(Socket,NewAck,Match,Counter-1); - {_,true} -> - maybe_done_receive(Socket,NewAck,Match,Counter-1); - _ -> - receive_line(Socket,NewAck,Match,Counter) - end - after 20000 -> - error - end. - - -%% Misc functions -fun_target(Addr, Fun) -> - io:format("["), - fun_target(Addr, Fun, 60). %Vx-cards need plenty of time. - -fun_target(_Addr, _Fun, 0) -> - io:format(" no contact with ts daemon]~n"), - {error,failed_to_connect}; -fun_target(Addr, Fun, Tries_left) -> - receive after 1 -> ok end, - case do_connect(Addr, Fun) of - {ok, Value} -> - io:format(" ok]~n"), - {ok, Value}; - _Error -> % typical {error, econnrefused} - io:format("."), - receive after 10000 -> ok end, - fun_target(Addr, Fun, Tries_left-1) - end. - -do_connect(Addr, Fun) -> - case gen_tcp:connect(Addr, ?TS_PORT, [{reuseaddr, true}], 60000) of - {ok, Socket} -> - Fun({ok, Socket}); - Error -> - Error - end. - - - |