From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/eunit/src/Makefile | 113 ++++++ lib/eunit/src/eunit.app.src | 21 ++ lib/eunit/src/eunit.appup.src | 1 + lib/eunit/src/eunit.erl | 250 +++++++++++++ lib/eunit/src/eunit_autoexport.erl | 104 ++++++ lib/eunit/src/eunit_data.erl | 732 +++++++++++++++++++++++++++++++++++++ lib/eunit/src/eunit_internal.hrl | 48 +++ lib/eunit/src/eunit_lib.erl | 576 +++++++++++++++++++++++++++++ lib/eunit/src/eunit_listener.erl | 178 +++++++++ lib/eunit/src/eunit_proc.erl | 661 +++++++++++++++++++++++++++++++++ lib/eunit/src/eunit_serial.erl | 186 ++++++++++ lib/eunit/src/eunit_server.erl | 341 +++++++++++++++++ lib/eunit/src/eunit_striptests.erl | 67 ++++ lib/eunit/src/eunit_surefire.erl | 417 +++++++++++++++++++++ lib/eunit/src/eunit_test.erl | 320 ++++++++++++++++ lib/eunit/src/eunit_tests.erl | 42 +++ lib/eunit/src/eunit_tty.erl | 257 +++++++++++++ 17 files changed, 4314 insertions(+) create mode 100644 lib/eunit/src/Makefile create mode 100644 lib/eunit/src/eunit.app.src create mode 100644 lib/eunit/src/eunit.appup.src create mode 100644 lib/eunit/src/eunit.erl create mode 100644 lib/eunit/src/eunit_autoexport.erl create mode 100644 lib/eunit/src/eunit_data.erl create mode 100644 lib/eunit/src/eunit_internal.hrl create mode 100644 lib/eunit/src/eunit_lib.erl create mode 100644 lib/eunit/src/eunit_listener.erl create mode 100644 lib/eunit/src/eunit_proc.erl create mode 100644 lib/eunit/src/eunit_serial.erl create mode 100644 lib/eunit/src/eunit_server.erl create mode 100644 lib/eunit/src/eunit_striptests.erl create mode 100644 lib/eunit/src/eunit_surefire.erl create mode 100644 lib/eunit/src/eunit_test.erl create mode 100644 lib/eunit/src/eunit_tests.erl create mode 100644 lib/eunit/src/eunit_tty.erl (limited to 'lib/eunit/src') diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile new file mode 100644 index 0000000000..4897c20ec1 --- /dev/null +++ b/lib/eunit/src/Makefile @@ -0,0 +1,113 @@ +# +# Copyright (C) 2008, Ericsson Telecommunications +# Authors: Richard Carlsson, Bertil Karlsson +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(EUNIT_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN) + + +# +# Common Macros +# + +EBIN = ../ebin +INCLUDE=../include + +ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard + +SOURCES= \ + eunit_autoexport.erl \ + eunit_striptests.erl \ + eunit.erl \ + eunit_tests.erl \ + eunit_server.erl \ + eunit_proc.erl \ + eunit_serial.erl \ + eunit_test.erl \ + eunit_lib.erl \ + eunit_data.erl \ + eunit_tty.erl \ + eunit_surefire.erl \ + eunit_listener.erl + +INCLUDE_FILES = eunit.hrl + +OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) + +INCLUDE_DELIVERABLES = $(INCLUDE_FILES:%=$(INCLUDE)/%) + +APP_FILE= eunit.app +APP_SRC= $(APP_FILE).src +APP_TARGET= $(EBIN)/$(APP_FILE) + +APPUP_FILE= eunit.appup +APPUP_SRC= $(APPUP_FILE).src +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(OBJECTS) + +docs: + +all: $(OBJECTS) + + +clean: + rm -f $(OBJECTS) + rm -f core *~ + +distclean: clean + +info: + @echo "MODULES: $(MODULES)" + @echo "EBIN: $(EBIN)" + @echo "EMULATOR: $(EMULATOR)" + @echo "APP_TARGET: $(APP_TARGET)" + @echo "TARGET_FILES: $(TARGET_FILES)" + @echo "DOC_TARGET_FILES: $(DOC_TARGET_FILES)" + @echo "DOCDIR/%html: $(DOCDIR)/%.html" + +realclean: clean + +$(EBIN)/%.$(EMULATOR):%.erl + erlc -W $(ERL_COMPILE_FLAGS) -o$(EBIN) $< + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(OBJECTS) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(SOURCES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/include + $(INSTALL_DATA) $(INCLUDE_DELIVERABLES) $(RELSYSDIR)/include + +release_docs_spec: + diff --git a/lib/eunit/src/eunit.app.src b/lib/eunit/src/eunit.app.src new file mode 100644 index 0000000000..4fd76588c3 --- /dev/null +++ b/lib/eunit/src/eunit.app.src @@ -0,0 +1,21 @@ +% This is an -*- erlang -*- file. + +{application, eunit, + [{description, "EUnit"}, + {vsn, "%VSN%"}, + {modules, [eunit, + eunit_autoexport, + eunit_striptests, + eunit_server, + eunit_proc, + eunit_serial, + eunit_test, + eunit_tests, + eunit_lib, + eunit_listener, + eunit_data, + eunit_tty, + eunit_surefire]}, + {registered,[]}, + {applications, [stdlib]}, + {env, []}]}. diff --git a/lib/eunit/src/eunit.appup.src b/lib/eunit/src/eunit.appup.src new file mode 100644 index 0000000000..54a63833e6 --- /dev/null +++ b/lib/eunit/src/eunit.appup.src @@ -0,0 +1 @@ +{"%VSN%",[],[]}. diff --git a/lib/eunit/src/eunit.erl b/lib/eunit/src/eunit.erl new file mode 100644 index 0000000000..59084a52fb --- /dev/null +++ b/lib/eunit/src/eunit.erl @@ -0,0 +1,250 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit.erl 339 2009-04-05 14:10:47Z rcarlsson $ +%% +%% @copyright 2004-2009 Mickaël Rémond, Richard Carlsson +%% @author Mickaël Rémond +%% [http://www.process-one.net/] +%% @author Richard Carlsson +%% [http://user.it.uu.se/~richardc/] +%% @version {@version}, {@date} {@time} +%% @doc This module is the main EUnit user interface. + +-module(eunit). + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +%% Official exports +-export([start/0, stop/0, test/1, test/2]). + +%% Experimental; may be removed or relocated +-export([start/1, stop/1, test/3, submit/1, submit/2, submit/3, watch/1, + watch/2, watch/3, watch_path/1, watch_path/2, watch_path/3, + watch_regexp/1, watch_regexp/2, watch_regexp/3, watch_app/1, + watch_app/2, watch_app/3]). + +%% EUnit entry points + +%% TODO: Command line interface similar to that of edoc? + +%% @doc Starts the EUnit server. Normally, you don't need to call this +%% function; it is started automatically. +start() -> + start(?SERVER). + +%% @private +%% @doc See {@link start/0}. +start(Server) -> + eunit_server:start(Server). + +%% @doc Stops the EUnit server. Normally, you don't need to call this +%% function. +stop() -> + stop(?SERVER). + +%% @private +%% @doc See {@link stop/0}. +stop(Server) -> + eunit_server:stop(Server). + +%% @private +watch(Target) -> + watch(Target, []). + +%% @private +watch(Target, Options) -> + watch(?SERVER, Target, Options). + +%% @private +watch(Server, Target, Options) -> + eunit_server:watch(Server, Target, Options). + +%% @private +watch_path(Target) -> + watch_path(Target, []). + +%% @private +watch_path(Target, Options) -> + watch_path(?SERVER, Target, Options). + +%% @private +watch_path(Server, Target, Options) -> + eunit_server:watch_path(Server, Target, Options). + +%% @private +watch_regexp(Target) -> + watch_regexp(Target, []). + +%% @private +watch_regexp(Target, Options) -> + watch_regexp(?SERVER, Target, Options). + +%% @private +watch_regexp(Server, Target, Options) -> + eunit_server:watch_regexp(Server, Target, Options). + +%% @private +watch_app(Name) -> + watch_app(Name, []). + +%% @private +watch_app(Name, Options) -> + watch_app(?SERVER, Name, Options). + +%% @private +watch_app(Server, Name, Options) -> + case code:lib_dir(Name) of + Path when is_list(Path) -> + watch_path(Server, filename:join(Path, "ebin"), Options); + _ -> + error + end. + +%% @equiv test(Tests, []) +test(Tests) -> + test(Tests, []). + +%% @spec test(Tests::term(), Options::[term()]) -> ok | {error, term()} +%% @doc Runs a set of tests. The format of `Tests' is described in the +%% section EUnit test +%% representation of the overview. +%% +%% Example: ```eunit:test(fred)''' runs all tests in the module `fred' +%% and also any tests in the module `fred_tests', if that module exists. +%% +%% Options: +%%
+%%
`verbose'
+%%
Displays more details about the running tests.
+%%
+%% +%% Options in the environment variable EUNIT are also included last in +%% the option list, i.e., have lower precedence than those in `Options'. +%% @see test/1 +test(Tests, Options) -> + test(?SERVER, Tests, all_options(Options)). + +%% @private +%% @doc See {@link test/2}. +test(Server, Tests, Options) -> + Listeners = [eunit_tty:start(Options) | listeners(Options)], + Serial = eunit_serial:start(Listeners), + case eunit_server:start_test(Server, Serial, Tests, Options) of + {ok, Reference} -> test_run(Reference, Listeners); + {error, R} -> {error, R} + end. + +test_run(Reference, Listeners) -> + receive + {start, Reference} -> + cast(Listeners, {start, Reference}) + end, + receive + {done, Reference} -> + cast(Listeners, {stop, Reference, self()}), + receive + {result, Reference, Result} -> + Result + end + end. + +cast([P | Ps], Msg) -> + P ! Msg, + cast(Ps, Msg); +cast([], _Msg) -> + ok. + +%% TODO: functions that run tests on a given node, not a given server +%% TODO: maybe some functions could check for a globally registered server? +%% TODO: some synchronous but completely quiet interface function + +%% @private +submit(T) -> + submit(T, []). + +%% @private +submit(T, Options) -> + submit(?SERVER, T, Options). + +%% @private +submit(Server, T, Options) -> + Dummy = spawn(fun devnull/0), + eunit_server:start_test(Server, Dummy, T, Options). + +listeners(Options) -> + Ps = start_listeners(proplists:get_all_values(report, Options)), + %% the event_log option is for debugging, to view the raw events + case proplists:get_value(event_log, Options) of + undefined -> + Ps; + X -> + LogFile = if is_list(X) -> X; + true -> "eunit-events.log" + end, + [spawn_link(fun () -> event_logger(LogFile) end) | Ps] + end. + +start_listeners([P | Ps]) when is_pid(P) ; is_atom(P) -> + [P | start_listeners(Ps)]; +start_listeners([{Mod, Opts} | Ps]) when is_atom(Mod) -> + [Mod:start(Opts) | start_listeners(Ps)]; +start_listeners([]) -> + []. + +%% TODO: make this report file errors +event_logger(LogFile) -> + case file:open(LogFile, [write]) of + {ok, FD} -> + receive + {start, Reference} -> + event_logger_loop(Reference, FD) + end; + Error -> + exit(Error) + end. + +event_logger_loop(Reference, FD) -> + receive + {status, _Id, _Info}=Msg -> + io:fwrite(FD, "~p.\n", [Msg]), + event_logger_loop(Reference, FD); + {stop, Reference, _ReplyTo} -> + %% no need to reply, just exit + file:close(FD), + exit(normal) + end. + +%% TODO: make a proper logger for asynchronous execution with submit/3 + +devnull() -> + receive _ -> devnull() end. + +%% including options from EUNIT environment variable + +all_options(Opts) -> + try os:getenv("EUNIT") of + false -> Opts; + S -> + {ok, Ts, _} = erl_scan:string(S), + {ok, V} = erl_parse:parse_term(Ts ++ [{dot,1}]), + if is_list(V) -> Opts ++ V; + true -> Opts ++ [V] + end + catch + _:_ -> Opts + end. diff --git a/lib/eunit/src/eunit_autoexport.erl b/lib/eunit/src/eunit_autoexport.erl new file mode 100644 index 0000000000..7b153c1194 --- /dev/null +++ b/lib/eunit/src/eunit_autoexport.erl @@ -0,0 +1,104 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_autoexport.erl 329 2009-03-01 11:23:32Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc Parse transform for automatic exporting of test functions. + +-module(eunit_autoexport). + +-include("eunit_internal.hrl"). + +-export([parse_transform/2]). + + +parse_transform(Forms, Options) -> + TestSuffix = proplists:get_value(eunit_test_suffix, Options, + ?DEFAULT_TEST_SUFFIX), + GeneratorSuffix = proplists:get_value(eunit_generator_suffix, + Options, + ?DEFAULT_GENERATOR_SUFFIX), + ExportSuffix = proplists:get_value(eunit_export_suffix, Options, + ?DEFAULT_EXPORT_SUFFIX), + F = fun (Form, Set) -> + form(Form, Set, TestSuffix, GeneratorSuffix, + ExportSuffix) + end, + Exports = sets:to_list(lists:foldl(F, sets:new(), Forms)), + rewrite(Forms, Exports). + +form({function, _L, Name, 0, _Cs}, S, TestSuffix, GeneratorSuffix, + ExportSuffix) -> + N = atom_to_list(Name), + case lists:suffix(TestSuffix, N) of + true -> + sets:add_element({Name, 0}, S); + false -> + case lists:suffix(GeneratorSuffix, N) of + true -> + sets:add_element({Name, 0}, S); + false -> + case lists:suffix(ExportSuffix, N) of + true -> + sets:add_element({Name, 0}, S); + false -> + S + end + end + end; +form({function, _L, ?DEFAULT_MODULE_WRAPPER_NAME, 1, _Cs}, S, _, _, _) -> + sets:add_element({?DEFAULT_MODULE_WRAPPER_NAME,1}, S); +form(_, S, _, _, _) -> + S. + +rewrite([{attribute,_,module,{Name,_Ps}}=M | Fs], Exports) -> + module_decl(Name, M, Fs, Exports); +rewrite([{attribute,_,module,Name}=M | Fs], Exports) -> + module_decl(Name, M, Fs, Exports); +rewrite([F | Fs], Exports) -> + [F | rewrite(Fs, Exports)]; +rewrite([], _Exports) -> + []. %% fail-safe, in case there is no module declaration + +rewrite([{function,_,test,0,_}=F | Fs], As, Module, _Test) -> + rewrite(Fs, [F | As], Module, false); +rewrite([F | Fs], As, Module, Test) -> + rewrite(Fs, [F | As], Module, Test); +rewrite([], As, Module, Test) -> + {if Test -> + EUnit = {record_field,0,{atom,0,''},{atom,0,eunit}}, + [{function,0,test,0, + [{clause,0,[],[], + [{call,0,{remote,0,EUnit,{atom,0,test}}, + [{atom,0,Module}]}]}]} + | As]; + true -> + As + end, + Test}. + +module_decl(Name, M, Fs, Exports) -> + Module = if is_atom(Name) -> Name; + true -> list_to_atom(packages:concat(Name)) + end, + {Fs1, Test} = rewrite(Fs, [], Module, true), + Es = if Test -> [{test,0} | Exports]; + true -> Exports + end, + [M, {attribute,0,export,Es} | lists:reverse(Fs1)]. diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl new file mode 100644 index 0000000000..0543b6c543 --- /dev/null +++ b/lib/eunit/src/eunit_data.erl @@ -0,0 +1,732 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id$ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc Interpretation of symbolic test representation + +-module(eunit_data). + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-include_lib("kernel/include/file.hrl"). + +-export([iter_init/2, iter_next/1, iter_prev/1, iter_id/1, + enter_context/3, get_module_tests/1]). + +-import(lists, [foldr/3]). + +-define(TICKS_PER_SECOND, 1000). + +%% @type tests() = +%% SimpleTest +%% | [tests()] +%% | moduleName() +%% | {module, moduleName()} +%% | {application, appName()} +%% | {application, appName(), [term()]} +%% | fileName() +%% | {file, fileName()} +%% | {string(), tests()} +%% | {generator, () -> tests()} +%% | {generator, M::moduleName(), F::functionName()} +%% | {spawn, tests()} +%% | {spawn, Node::atom(), tests()} +%% | {timeout, T::number(), tests()} +%% | {inorder, tests()} +%% | {inparallel, tests()} +%% | {inparallel, N::integer(), tests()} +%% | {with, X::any(), [AbstractTestFunction]} +%% | {setup, Where::local | spawn | {spawn, Node::atom()}, +%% Setup::() -> (R::any()), +%% Cleanup::(R::any()) -> any(), +%% tests() | Instantiator +%% } +%% | {setup, Setup, Cleanup, tests() | Instantiator} +%% | {setup, Where, Setup, tests() | Instantiator} +%% | {setup, Setup, tests() | Instantiator} +%% | {foreach, Where::local | spawn | {spawn, Node::atom()}, +%% Setup::() -> (R::any()), +%% Cleanup::(R::any()) -> any(), +%% [tests() | Instantiator] +%% } +%% | {foreach, Setup, Cleanup, [tests() | Instantiator]} +%% | {foreach, Where, Setup, [tests() | Instantiator]} +%% | {foreach, Setup, [tests() | Instantiator]} +%% | {foreachx, Where::local | spawn | {spawn, Node::atom()}, +%% SetupX::(X::any()) -> (R::any()), +%% CleanupX::(X::any(), R::any()) -> any(), +%% Pairs::[{X::any(), +%% (X::any(), R::any()) -> tests()}] +%% } +%% | {foreachx, SetupX, CleanupX, Pairs} +%% | {foreachx, Where, SetupX, Pairs} +%% | {foreachx, SetupX, Pairs} +%% | {node, Node::atom(), tests() | Instantiator} +%% | {node, Node, Args::string(), tests() | Instantiator} +%% +%% SimpleTest = TestFunction | {Line::integer(), SimpleTest} +%% +%% TestFunction = () -> any() +%% | {M::moduleName(), F::functionName()}. +%% +%% AbstractTestFunction = (X::any()) -> any() +%% +%% Instantiator = (R::any()) -> tests() +%% | {with, [AbstractTestFunction]} +%% +%% Note that `{string(), ...}' is a short-hand for `{string(), {...}}' +%% if the tuple contains more than two elements. +%% +%% @type moduleName() = atom() +%% @type functionName() = atom() +%% @type arity() = integer() +%% @type appName() = atom() +%% @type fileName() = string() + +%% TODO: Can we mark up tests as known-failures? +%% TODO: Is it possible to handle known timout/setup failures? +%% TODO: Add diagnostic tests which never fail, but may cause warnings? + +%% --------------------------------------------------------------------- +%% Abstract test set iterator + +-record(iter, + {prev = [], + next = [], + tests = [], + pos = 0, + parent = []}). + +%% @spec (tests(), [integer()]) -> testIterator() +%% @type testIterator() + +iter_init(Tests, ParentID) -> + #iter{tests = Tests, parent = lists:reverse(ParentID)}. + +%% @spec (testIterator()) -> [integer()] + +iter_id(#iter{pos = N, parent = Ns}) -> + lists:reverse(Ns, [N]). + +%% @spec (testIterator()) -> none | {testItem(), testIterator()} + +iter_next(I = #iter{next = []}) -> + case next(I#iter.tests) of + {T, Tests} -> + {T, I#iter{prev = [T | I#iter.prev], + tests = Tests, + pos = I#iter.pos + 1}}; + none -> + none + end; +iter_next(I = #iter{next = [T | Ts]}) -> + {T, I#iter{next = Ts, + prev = [T | I#iter.prev], + pos = I#iter.pos + 1}}. + +%% @spec (testIterator()) -> none | {testItem(), testIterator()} + +iter_prev(#iter{prev = []}) -> + none; +iter_prev(#iter{prev = [T | Ts], next = Next, pos = Pos} = I) -> + {T, I#iter{prev = Ts, next = [T | Next], pos = Pos - 1}}. + + +%% --------------------------------------------------------------------- +%% Concrete test set representation iterator + +%% @spec (tests()) -> none | {testItem(), tests()} +%% @type testItem() = #test{} | #group{} +%% @throws {bad_test, term()} +%% | {generator_failed, exception()} +%% | {no_such_function, eunit_lib:mfa()} +%% | {module_not_found, moduleName()} +%% | {application_not_found, appName()} +%% | {file_read_error, {Reason::atom(), Message::string(), +%% fileName()}} + +next(Tests) -> + case eunit_lib:dlist_next(Tests) of + [T | Ts] -> + case parse(T) of + {data, T1} -> + next([T1 | Ts]); + T1 -> + {T1, Ts} + end; + [] -> + none + end. + +%% this returns either a #test{} or #group{} record, or {data, T} to +%% signal that T has been substituted for the given representation + +parse({foreach, S, Fs}) when is_function(S), is_list(Fs) -> + parse({foreach, S, fun ok/1, Fs}); +parse({foreach, S, C, Fs}) + when is_function(S), is_function(C), is_list(Fs) -> + parse({foreach, ?DEFAULT_SETUP_PROCESS, S, C, Fs}); +parse({foreach, P, S, Fs}) + when is_function(S), is_list(Fs) -> + parse({foreach, P, S, fun ok/1, Fs}); +parse({foreach, P, S, C, Fs} = T) + when is_function(S), is_function(C), is_list(Fs) -> + check_arity(S, 0, T), + check_arity(C, 1, T), + case Fs of + [F | Fs1] -> + {data, [{setup, P, S, C, F}, {foreach, P, S, C, Fs1}]}; + [] -> + {data, []} + end; +parse({foreachx, S1, Ps}) when is_function(S1), is_list(Ps) -> + parse({foreachx, S1, fun ok/2, Ps}); +parse({foreachx, S1, C1, Ps}) + when is_function(S1), is_function(C1), is_list(Ps) -> + parse({foreachx, ?DEFAULT_SETUP_PROCESS, S1, C1, Ps}); +parse({foreachx, P, S1, Ps}) + when is_function(S1), is_list(Ps) -> + parse({foreachx, P, S1, fun ok/2, Ps}); +parse({foreachx, P, S1, C1, Ps} = T) + when is_function(S1), is_function(C1), is_list(Ps) -> + check_arity(S1, 1, T), + check_arity(C1, 2, T), + case Ps of + [{X, F1} | Ps1] when is_function(F1) -> + check_arity(F1, 2, T), + S = fun () -> S1(X) end, + C = fun (R) -> C1(X, R) end, + F = fun (R) -> F1(X, R) end, + {data, [{setup, P, S, C, F}, {foreachx, P, S1, C1, Ps1}]}; + [_|_] -> + bad_test(T); + [] -> + {data, []} + end; +parse({generator, F} = T) when is_function(F) -> + check_arity(F, 0, T), + %% use run_testfun/1 to handle wrapper exceptions + case eunit_test:run_testfun(F) of + {ok, T1} -> + {data, T1}; + {error, {Class, Reason, Trace}} -> + throw({generator_failed, {Class, Reason, Trace}}) + end; +parse({generator, M, F}) when is_atom(M), is_atom(F) -> + parse({generator, eunit_test:function_wrapper(M, F)}); +parse({inorder, T}) -> + group(#group{tests = T, order = inorder}); +parse({inparallel, T}) -> + parse({inparallel, 0, T}); +parse({inparallel, N, T}) when is_integer(N), N >= 0 -> + group(#group{tests = T, order = {inparallel, N}}); +parse({timeout, N, T}) when is_number(N), N >= 0 -> + group(#group{tests = T, timeout = round(N * ?TICKS_PER_SECOND)}); +parse({spawn, T}) -> + group(#group{tests = T, spawn = local}); +parse({spawn, N, T}) when is_atom(N) -> + group(#group{tests = T, spawn = {remote, N}}); +parse({setup, S, I}) when is_function(S); is_list(S) -> + parse({setup, ?DEFAULT_SETUP_PROCESS, S, I}); +parse({setup, S, C, I}) when is_function(S), is_function(C) -> + parse({setup, ?DEFAULT_SETUP_PROCESS, S, C, I}); +parse({setup, P, S, I}) when is_function(S) -> + parse({setup, P, S, fun ok/1, I}); +parse({setup, P, L, I} = T) when is_list(L) -> + check_setup_list(L, T), + {S, C} = eunit_test:multi_setup(L), + parse({setup, P, S, C, I}); +parse({setup, P, S, C, I} = T) + when is_function(S), is_function(C), is_function(I) -> + check_arity(S, 0, T), + check_arity(C, 1, T), + case erlang:fun_info(I, arity) of + {arity, 0} -> + %% if I is nullary, it is a plain test + parse({setup, S, C, fun (_) -> I end}); + _ -> + %% otherwise, I must be an instantiator function + check_arity(I, 1, T), + case P of + local -> ok; + spawn -> ok; + {spawn, N} when is_atom(N) -> ok; + _ -> bad_test(T) + end, + group(#group{tests = I, + context = #context{setup = S, cleanup = C, + process = P}}) + end; +parse({setup, P, S, C, {with, As}}) when is_list(As) -> + parse({setup, P, S, C, fun (X) -> {with, X, As} end}); +parse({setup, P, S, C, T}) when is_function(S), is_function(C) -> + parse({setup, P, S, C, fun (_) -> T end}); +parse({node, N, T}) when is_atom(N) -> + parse({node, N, "", T}); +parse({node, N, A, T1}=T) when is_atom(N) -> + case eunit_lib:is_string(A) of + true -> + %% TODO: better stack traces for internal funs like these + parse({setup, + fun () -> + %% TODO: auto-start net_kernel if needed + StartedNet = false, +%% The following is commented out because of problems when running +%% eunit as part of the init sequence (from the command line): +%% StartedNet = +%% case whereis(net_kernel) of +%% undefined -> +%% M = list_to_atom(atom_to_list(N) +%% ++ "_master"), +%% case net_kernel:start([M]) of +%% {ok, _} -> +%% true; +%% {error, E} -> +%% throw({net_kernel_start, E}) +%% end; +%% _ -> false +%% end, +%% ?debugVal({started, StartedNet}), + {Name, Host} = eunit_lib:split_node(N), + {ok, Node} = slave:start_link(Host, Name, A), + {Node, StartedNet} + end, + fun ({Node, StopNet}) -> +%% ?debugVal({stop, StopNet}), + slave:stop(Node), + case StopNet of + true -> net_kernel:stop(); + false -> ok + end + end, + T1}); + false -> + bad_test(T) + end; +parse({module, M}) when is_atom(M) -> + {data, {"module '" ++ atom_to_list(M) ++ "'", get_module_tests(M)}}; +parse({application, A}) when is_atom(A) -> + try parse({file, atom_to_list(A)++".app"}) + catch + {file_read_error,{enoent,_,_}} -> + case code:lib_dir(A) of + Dir when is_list(Dir) -> + %% add "ebin" if it exists, like code_server does + BinDir = filename:join(Dir, "ebin"), + case file:read_file_info(BinDir) of + {ok, #file_info{type=directory}} -> + parse({dir, BinDir}); + _ -> + parse({dir, Dir}) + end; + _ -> + throw({application_not_found, A}) + end + end; +parse({application, A, Info}=T) when is_atom(A) -> + case proplists:get_value(modules, Info) of + Ms when is_list(Ms) -> + case [M || M <- Ms, not is_atom(M)] of + [] -> + {data, {"application '" ++ atom_to_list(A) ++ "'", Ms}}; + _ -> + bad_test(T) + end; + _ -> + bad_test(T) + end; +parse({file, F} = T) when is_list(F) -> + case eunit_lib:is_string(F) of + true -> + {data, {"file \"" ++ F ++ "\"", get_file_tests(F)}}; + false -> + bad_test(T) + end; +parse({dir, D}=T) when is_list(D) -> + case eunit_lib:is_string(D) of + true -> + {data, {"directory \"" ++ D ++ "\"", get_directory_modules(D)}}; + false -> + bad_test(T) + end; +parse({with, X, As}=T) when is_list(As) -> + case As of + [A | As1] -> + check_arity(A, 1, T), + {data, [{eunit_lib:fun_parent(A), fun () -> A(X) end}, + {with, X, As1}]}; + [] -> + {data, []} + end; +parse({S, T1} = T) when is_list(S) -> + case eunit_lib:is_string(S) of + true -> + group(#group{tests = T1, desc = list_to_binary(S)}); + false -> + bad_test(T) + end; +parse({S, T1}) when is_binary(S) -> + group(#group{tests = T1, desc = S}); +parse(T) when tuple_size(T) > 2, is_list(element(1, T)) -> + [S | Es] = tuple_to_list(T), + parse({S, list_to_tuple(Es)}); +parse(T) when tuple_size(T) > 2, is_binary(element(1, T)) -> + [S | Es] = tuple_to_list(T), + parse({S, list_to_tuple(Es)}); +parse(M) when is_atom(M) -> + parse({module, M}); +parse(T) when is_list(T) -> + case eunit_lib:is_string(T) of + true -> + try parse({dir, T}) + catch + {file_read_error,{R,_,_}} + when R =:= enotdir; R =:= enoent -> + parse({file, T}) + end; + false -> + bad_test(T) + end; +parse(T) -> + parse_simple(T). + +%% parse_simple always produces a #test{} record + +parse_simple({L, F}) when is_integer(L), L >= 0 -> + (parse_simple(F))#test{line = L}; +parse_simple({{M,N,A}=Loc, F}) when is_atom(M), is_atom(N), is_integer(A) -> + (parse_simple(F))#test{location = Loc}; +parse_simple(F) -> + parse_function(F). + +parse_function(F) when is_function(F) -> + check_arity(F, 0, F), + #test{f = F, location = eunit_lib:fun_parent(F)}; +parse_function({M,F}) when is_atom(M), is_atom(F) -> + #test{f = eunit_test:function_wrapper(M, F), location = {M, F, 0}}; +parse_function(F) -> + bad_test(F). + +check_arity(F, N, T) when is_function(F) -> + case erlang:fun_info(F, arity) of + {arity, N} -> + ok; + _ -> + bad_test(T) + end; +check_arity(_, _, T) -> + bad_test(T). + +check_setup_list([{Tag, S, C} | Es], T) + when is_atom(Tag), is_function(S), is_function(C) -> + check_arity(S, 0, T), + check_arity(C, 1, T), + check_setup_list(Es, T); +check_setup_list([{Tag, S} | Es], T) + when is_atom(Tag), is_function(S) -> + check_arity(S, 0, T), + check_setup_list(Es, T); +check_setup_list([], _T) -> + ok; +check_setup_list(_, T) -> + bad_test(T). + +bad_test(T) -> + throw({bad_test, T}). + +ok(_) -> ok. +ok(_, _) -> ok. + +%% This does some look-ahead and folds nested groups and tests where +%% possible. E.g., {String, Test} -> Test#test{desc = String}. + +group(#group{context = #context{}} = G) -> + %% leave as it is - the test body is an instantiator, which is not + %% suitable for lookahead (and anyway, properties of the setup + %% should not be merged with properties of its body, e.g. spawn) + G; +group(#group{tests = T0, desc = Desc, order = Order, context = Context, + spawn = Spawn, timeout = Timeout} = G) -> + {T1, Ts} = lookahead(T0), + {T2, _} = lookahead(Ts), + case T1 of + #test{desc = Desc1, timeout = Timeout1} + when T2 =:= none, Spawn =:= undefined, Context =:= undefined, + ((Desc =:= undefined) or (Desc1 =:= undefined)), + ((Timeout =:= undefined) or (Timeout1 =:= undefined)) -> + %% a single test within a non-spawn/setup group: put the + %% information directly on the test; drop the order + T1#test{desc = join_properties(Desc, Desc1), + timeout = join_properties(Timeout, Timeout1)}; + + #test{timeout = undefined} + when T2 =:= none, Timeout =/= undefined, Context =:= undefined -> + %% a single test without timeout, within a non-joinable + %% group with a timeout and no fixture: push the timeout to + %% the test + G#group{tests = {timeout, (Timeout div ?TICKS_PER_SECOND), T0}, + timeout = undefined}; + + #group{desc = Desc1, order = Order1, context = Context1, + spawn = Spawn1, timeout = Timeout1} + when T2 =:= none, + ((Desc =:= undefined) or (Desc1 =:= undefined)), + ((Order =:= undefined) or (Order1 =:= undefined)), + ((Context =:= undefined) or (Context1 =:= undefined)), + ((Spawn =:= undefined) or (Spawn1 =:= undefined)), + ((Timeout =:= undefined) or (Timeout1 =:= undefined)) -> + %% two nested groups with non-conflicting properties + group(T1#group{desc = join_properties(Desc, Desc1), + order = join_properties(Order, Order1), + context = join_properties(Context, Context1), + spawn = join_properties(Spawn, Spawn1), + timeout = join_properties(Timeout, Timeout1)}); + + #group{order = Order1, timeout = Timeout1} + when T2 =:= none -> + %% two nested groups that cannot be joined: try to push the + %% timeout and ordering properties to the inner group + push_order(Order, Order1, push_timeout(Timeout, Timeout1, G)); + + _ -> + %% leave the group as it is and discard the lookahead + G + end. + +lookahead(T) -> + case next(T) of + {T1, Ts} -> {T1, Ts}; + none -> {none, []} + end. + +join_properties(undefined, X) -> X; +join_properties(X, undefined) -> X. + +push_timeout(Timeout, undefined, G=#group{context=undefined}) + when Timeout =/= undefined -> + %% A timeout on a context (fixture) includes the setup/cleanup time + %% and must not be propagated into the body + G#group{tests = {timeout, (Timeout div ?TICKS_PER_SECOND), G#group.tests}, + timeout = undefined}; +push_timeout(_, _, G) -> + G. + +push_order(inorder, undefined, G) -> + G#group{tests = {inorder, G#group.tests}, order = undefined}; +push_order({inparallel, N}, undefined, G) -> + G#group{tests = {inparallel, N, G#group.tests}, order = undefined}; +push_order(_, _, G) -> + G. + +%% --------------------------------------------------------------------- +%% Extracting test funs from a module + +%% @throws {module_not_found, moduleName()} + +get_module_tests(M) -> + try M:module_info(exports) of + Es -> + Fs = get_module_tests_1(M, Es), + W = ?DEFAULT_MODULE_WRAPPER_NAME, + case lists:member({W,1}, Es) of + false -> Fs; + true -> {generator, fun () -> M:W(Fs) end} + end + catch + error:undef -> + throw({module_not_found, M}) + end. + +get_module_tests_1(M, Es) -> + Fs = testfuns(Es, M, ?DEFAULT_TEST_SUFFIX, + ?DEFAULT_GENERATOR_SUFFIX), + Name = atom_to_list(M), + case lists:suffix(?DEFAULT_TESTMODULE_SUFFIX, Name) of + false -> + Name1 = Name ++ ?DEFAULT_TESTMODULE_SUFFIX, + M1 = list_to_atom(Name1), + try get_module_tests(M1) of + Fs1 -> + Fs ++ [{"module '" ++ Name1 ++ "'", Fs1}] + catch + {module_not_found, M1} -> + Fs + end; + true -> + Fs + end. + +testfuns(Es, M, TestSuffix, GeneratorSuffix) -> + foldr(fun ({F, 0}, Fs) -> + N = atom_to_list(F), + case lists:suffix(TestSuffix, N) of + true -> + [{M,F} | Fs]; + false -> + case lists:suffix(GeneratorSuffix, N) of + true -> + [{generator, M, F} | Fs]; + false -> + Fs + end + end; + (_, Fs) -> + Fs + end, + [], + Es). + + +%% --------------------------------------------------------------------- +%% Getting a test set from a file + +%% @throws {file_read_error, {Reason::atom(), Message::string(), +%% fileName()}} + +get_file_tests(F) -> + case is_module_filename(F) of + true -> + %% look relative to current dir first + case file:read_file_info(F) of + {ok, #file_info{type=regular}} -> + objfile_test(F); + _ -> + %% (where_is_file/1 does not take a path argument) + case code:where_is_file(F) of + non_existing -> + %% this will produce a suitable error message + objfile_test(F); + Path -> + objfile_test(Path) + end + end; + false -> + eunit_lib:consult_file(F) + end. + +is_module_filename(F) -> + filename:extension(F) =:= code:objfile_extension(). + +objfile_test(File) -> + try + {module, M} = lists:keyfind(module, 1, beam_lib:info(File)), + {setup, + fun () -> + %% TODO: better error/stacktrace for this internal fun + code:purge(M), + {module,M} = code:load_abs(filename:rootname(File)), + ok + end, + {module, M}} + catch + _:_ -> + throw({file_read_error, + {undefined, "extracting module name failed", File}}) + end. + + +%% --------------------------------------------------------------------- +%% Getting a list of module names from object files in a directory + +%% @throws {file_read_error, {Reason::atom(), Message::string(), +%% fileName()}} + +%% TODO: handle packages (recursive search for files) + +get_directory_modules(D) -> + [objfile_test(filename:join(D, F)) + || F <- eunit_lib:list_dir(D), is_module_filename(F)]. + + + +%% --------------------------------------------------------------------- +%% Entering a setup-context, with guaranteed cleanup. + +%% @spec (Tests::#context{}, Instantiate, Callback) -> any() +%% Instantiate = (any()) -> tests() +%% Callback = (tests()) -> any() +%% @throws {context_error, Error, eunit_lib:exception()} +%% Error = setup_failed | instantiation_failed | cleanup_failed + +enter_context(#context{setup = S, cleanup = C, process = P}, I, F) -> + F1 = case P of + local -> F; + spawn -> fun (X) -> F({spawn, X}) end; + {spawn, N} -> fun (T) -> F({spawn, N, T}) end + end, + eunit_test:enter_context(S, C, I, F1). + + +-ifdef(TEST). +generator_exported_() -> + generator(). + +generator() -> + T = ?_test(ok), + [T, T, T]. + +echo_proc() -> + receive {P,X} -> P ! X, echo_proc() end. + +ping(P) -> + P ! {self(),ping}, receive ping -> ok end. + +data_test_() -> + Setup = fun () -> spawn(fun echo_proc/0) end, + Cleanup = fun (Pid) -> exit(Pid, kill) end, + Fail = ?_test(throw(eunit)), + T = ?_test(ok), + Tests = [T,T,T], + [?_assertMatch(ok, eunit:test(T)), + ?_assertMatch(error, eunit:test(Fail)), + ?_assertMatch(ok, eunit:test({generator, fun () -> Tests end})), + ?_assertMatch(ok, eunit:test({generator, fun generator/0})), + ?_assertMatch(ok, eunit:test({generator, ?MODULE, generator_exported_})), + ?_assertMatch(ok, eunit:test({inorder, Tests})), + ?_assertMatch(ok, eunit:test({inparallel, Tests})), + ?_assertMatch(ok, eunit:test({timeout, 10, Tests})), + ?_assertMatch(ok, eunit:test({spawn, Tests})), + ?_assertMatch(ok, eunit:test({setup, Setup, Cleanup, + fun (P) -> ?_test(ok = ping(P)) end})), + %%?_assertMatch(ok, eunit:test({node, test@localhost, Tests})), + ?_assertMatch(ok, eunit:test({module, eunit_lib})), + ?_assertMatch(ok, eunit:test(eunit_lib)), + ?_assertMatch(ok, eunit:test("examples/tests.txt")) + + %%?_test({foreach, Setup, [T, T, T]}) + ]. + +lazy_test_() -> + {spawn, [?_test(undefined = put(count, 0)), + lazy_gen(7), + ?_assertMatch(7, get(count))]}. + +lazy_gen(N) -> + {generator, + fun () -> + if N > 0 -> + [?_test(put(count,1+get(count))) + | lazy_gen(N-1)]; + true -> + [] + end + end}. +-endif. diff --git a/lib/eunit/src/eunit_internal.hrl b/lib/eunit/src/eunit_internal.hrl new file mode 100644 index 0000000000..8d0ac30bd7 --- /dev/null +++ b/lib/eunit/src/eunit_internal.hrl @@ -0,0 +1,48 @@ +%% ------------------------------------------------------------------- +%% File: eunit_internal.hrl +%% +%% $Id: eunit_internal.hrl 329 2009-03-01 11:23:32Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @doc + +-define(SERVER, eunit_server). +-define(DEFAULT_TEST_SUFFIX, "_test"). +-define(DEFAULT_GENERATOR_SUFFIX, "_test_"). +-define(DEFAULT_EXPORT_SUFFIX, "_exported_"). +-define(DEFAULT_TESTMODULE_SUFFIX, "_tests"). +-define(DEFAULT_GROUP_TIMEOUT, infinity). +-define(DEFAULT_TEST_TIMEOUT, 5000). +-define(DEFAULT_SETUP_PROCESS, spawn). +-define(DEFAULT_MODULE_WRAPPER_NAME, eunit_wrapper_). + +-ifdef(DEBUG). +-define(debugmsg(S),io:fwrite("\n* ~s: ~s\n", [?MODULE,S])). +-define(debugmsg1(S,As),io:fwrite("\n* ~s: " ++ S ++ "\n", [?MODULE] ++ As)). +-else. +-define(debugmsg(S),ok). +-define(debugmsg1(S,As),ok). +-endif. + + +%% --------------------------------------------------------------------- +%% Internal test data representation + +-record(test, {f = undefined, + desc = undefined, + timeout = undefined, + location = undefined, + line = 0 + }). + +-record(group, {desc = undefined, + order = undefined, % run in order or in parallel + timeout = undefined, + context = undefined, % setup-context record + spawn = undefined, % run group in new process + tests = undefined}). + +-record(context, {setup = undefined, + cleanup = undefined, + process = local}). % spawn new process for body diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl new file mode 100644 index 0000000000..4751f1094a --- /dev/null +++ b/lib/eunit/src/eunit_lib.erl @@ -0,0 +1,576 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_lib.erl 339 2009-04-05 14:10:47Z rcarlsson $ +%% +%% @copyright 2004-2007 Mickaël Rémond, Richard Carlsson +%% @author Mickaël Rémond +%% [http://www.process-one.net/] +%% @author Richard Carlsson +%% [http://user.it.uu.se/~richardc/] +%% @private +%% @see eunit +%% @doc Utility functions for eunit + +-module(eunit_lib). + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + + +-export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1, + command/2, command/3, trie_new/0, trie_store/2, trie_match/2, + split_node/1, consult_file/1, list_dir/1, format_exit_term/1, + format_exception/1, format_error/1]). + + +%% Type definitions for describing exceptions +%% +%% @type exception() = {exceptionClass(), Reason::term(), stackTrace()} +%% +%% @type exceptionClass() = error | exit | throw +%% +%% @type stackTrace() = [{moduleName(), functionName(), +%% arity() | argList()}] +%% +%% @type moduleName() = atom() +%% @type functionName() = atom() +%% @type arity() = integer() +%% @type mfa() = {moduleName(), functionName(), arity()} +%% @type argList() = [term()] +%% @type fileName() = string() + + +%% --------------------------------------------------------------------- +%% Formatting of error descriptors + +format_exception({Class,Term,Trace}) + when is_atom(Class), is_list(Trace) -> + case is_stacktrace(Trace) of + true -> + io_lib:format("~w:~P\n~s", + [Class, Term, 20, format_stacktrace(Trace)]); + false -> + format_term(Term) + end; +format_exception(Term) -> + format_term(Term). + +format_term(Term) -> + io_lib:format("~P\n", [Term, 15]). + +format_exit_term(Term) -> + {Reason, Trace} = analyze_exit_term(Term), + io_lib:format("~P~s", [Reason, 15, Trace]). + +analyze_exit_term({Reason, [_|_]=Trace}=Term) -> + case is_stacktrace(Trace) of + true -> + {Reason, format_stacktrace(Trace)}; + false -> + {Term, ""} + end; +analyze_exit_term(Term) -> + {Term, ""}. + +is_stacktrace([]) -> + true; +is_stacktrace([{M,F,A}|Fs]) when is_atom(M), is_atom(F), is_integer(A) -> + is_stacktrace(Fs); +is_stacktrace([{M,F,As}|Fs]) when is_atom(M), is_atom(F), is_list(As) -> + is_stacktrace(Fs); +is_stacktrace(_) -> + false. + +format_stacktrace(Trace) -> + format_stacktrace(Trace, "in function", "in call from"). + +format_stacktrace([{M,F,A}|Fs], Pre, Pre1) when is_integer(A) -> + [io_lib:fwrite(" ~s ~w:~w/~w\n", [Pre, M, F, A]) + | format_stacktrace(Fs, Pre1, Pre1)]; +format_stacktrace([{M,F,As}|Fs], Pre, Pre1) when is_list(As) -> + A = length(As), + C = case is_op(M,F,A) of + true when A =:= 1 -> + [A1] = As, + io_lib:fwrite("~s ~s", [F,format_arg(A1)]); + true when A =:= 2 -> + [A1, A2] = As, + io_lib:fwrite("~s ~s ~s", + [format_arg(A1),F,format_arg(A2)]); + false -> + io_lib:fwrite("~w(~s)", [F,format_arglist(As)]) + end, + [io_lib:fwrite(" ~s ~w:~w/~w\n called as ~s\n", + [Pre,M,F,A,C]) + | format_stacktrace(Fs,Pre1,Pre1)]; +format_stacktrace([],_Pre,_Pre1) -> + "". + +format_arg(A) -> + io_lib:format("~P",[A,15]). + +format_arglist([A]) -> + format_arg(A); +format_arglist([A|As]) -> + [io_lib:format("~P,",[A,15]) | format_arglist(As)]; +format_arglist([]) -> + "". + +is_op(erlang, F, A) -> + erl_internal:arith_op(F, A) + orelse erl_internal:bool_op(F, A) + orelse erl_internal:comp_op(F, A) + orelse erl_internal:list_op(F, A) + orelse erl_internal:send_op(F, A); +is_op(_M, _F, _A) -> + false. + +format_error({bad_test, Term}) -> + error_msg("bad test descriptor", "~P", [Term, 15]); +format_error({generator_failed, Exception}) -> + error_msg("test generator failed", "~s", + [format_exception(Exception)]); +format_error({no_such_function, {M,F,A}}) + when is_atom(M), is_atom(F), is_integer(A) -> + error_msg(io_lib:format("no such function: ~w:~w/~w", [M,F,A]), + "", []); +format_error({module_not_found, M}) -> + error_msg("test module not found", "~p", [M]); +format_error({application_not_found, A}) when is_atom(A) -> + error_msg("application not found", "~w", [A]); +format_error({file_read_error, {_R, Msg, F}}) -> + error_msg("error reading file", "~s: ~s", [Msg, F]); +format_error({setup_failed, Exception}) -> + error_msg("context setup failed", "~s", + [format_exception(Exception)]); +format_error({cleanup_failed, Exception}) -> + error_msg("context cleanup failed", "~s", + [format_exception(Exception)]); +format_error({instantiation_failed, Exception}) -> + error_msg("instantiation of subtests failed", "~s", + [format_exception(Exception)]). + +error_msg(Title, Fmt, Args) -> + Msg = io_lib:format("::"++Fmt, Args), % gets indentation right + io_lib:fwrite("*** ~s ***\n~s\n\n", [Title, Msg]). + + +%% --------------------------------------------------------------------- +%% Deep list iterator; accepts improper lists/sublists, and also accepts +%% non-lists on the top level. Nonempty strings (not deep strings) are +%% recognized as separate elements, even on the top level. (It is not +%% recommended to include integers in the deep list, since a list of +%% integers is likely to be interpreted as a string.). The result is +%% always presented as a list (which may be improper), which is either +%% empty or otherwise has a non-list head element. + +dlist_next([X | Xs] = Xs0) when is_list(X) -> + case is_nonempty_string(X) of + true -> Xs0; + false -> dlist_next(X, Xs) + end; +dlist_next([_|_] = Xs) -> + case is_nonempty_string(Xs) of + true -> [Xs]; + false -> Xs + end; +dlist_next([]) -> + []; +dlist_next(X) -> + [X]. + +%% the first two clauses avoid pushing empty lists on the stack +dlist_next([X], Ys) when is_list(X) -> + case is_nonempty_string(X) of + true -> [X | Ys]; + false -> dlist_next(X, Ys) + end; +dlist_next([X], Ys) -> + [X | Ys]; +dlist_next([X | Xs], Ys) when is_list(X) -> + case is_nonempty_string(X) of + true -> [X | [Xs | Ys]]; + false -> dlist_next(X, [Xs | Ys]) + end; +dlist_next([X | Xs], Ys) -> + [X | [Xs | Ys]]; +dlist_next([], Xs) -> + dlist_next(Xs). + + +-ifdef(TEST). +dlist_test_() -> + {"deep list traversal", + [{"non-list term -> singleton list", + ?_test([any] = dlist_next(any))}, + {"empty list -> empty list", + ?_test([] = dlist_next([]))}, + {"singleton list -> singleton list", + ?_test([any] = dlist_next([any]))}, + {"taking the head of a flat list", + ?_test([a,b,c] = dlist_next([a,b,c]))}, + {"skipping an initial empty list", + ?_test([a,b,c] = dlist_next([[],a,b,c]))}, + {"skipping nested initial empty lists", + ?_test([a,b,c] = dlist_next([[[[]]],a,b,c]))}, + {"skipping a final empty list", + ?_test([] = dlist_next([[]]))}, + {"skipping nested final empty lists", + ?_test([] = dlist_next([[[[]]]]))}, + {"the first element is in a sublist", + ?_test([a,b,c] = dlist_next([[a],b,c]))}, + {"recognizing a naked string", + ?_test(["abc"] = dlist_next("abc"))}, + {"recognizing a wrapped string", + ?_test(["abc"] = dlist_next(["abc"]))}, + {"recognizing a leading string", + ?_test(["abc",a,b,c] = dlist_next(["abc",a,b,c]))}, + {"recognizing a nested string", + ?_test(["abc"] = dlist_next([["abc"]]))}, + {"recognizing a leading string in a sublist", + ?_test(["abc",a,b,c] = dlist_next([["abc"],a,b,c]))}, + {"traversing an empty list", + ?_test([] = dlist_flatten([]))}, + {"traversing a flat list", + ?_test([a,b,c] = dlist_flatten([a,b,c]))}, + {"traversing a deep list", + ?_test([a,b,c] = dlist_flatten([[],[a,[b,[]],c],[]]))}, + {"traversing a deep but empty list", + ?_test([] = dlist_flatten([[],[[[]]],[]]))} + ]}. + +%% test support +dlist_flatten(Xs) -> + case dlist_next(Xs) of + [X | Xs1] -> [X | dlist_flatten(Xs1)]; + [] -> [] + end. +-endif. + + +%% --------------------------------------------------------------------- +%% Check for proper Unicode-stringness. + +is_string([C | Cs]) when is_integer(C), C >= 0, C =< 16#10ffff -> + is_string(Cs); +is_string([_ | _]) -> + false; +is_string([]) -> + true; +is_string(_) -> + false. + +is_nonempty_string([]) -> false; +is_nonempty_string(Cs) -> is_string(Cs). + +-ifdef(TEST). +is_string_test_() -> + {"is_string", + [{"no non-lists", ?_assert(not is_string($A))}, + {"no non-integer lists", ?_assert(not is_string([true]))}, + {"empty string", ?_assert(is_string(""))}, + {"ascii string", ?_assert(is_string(lists:seq(0, 127)))}, + {"latin-1 string", ?_assert(is_string(lists:seq(0, 255)))}, + {"unicode string", + ?_assert(is_string([0, $A, 16#10fffe, 16#10ffff]))}, + {"not above unicode range", + ?_assert(not is_string([0, $A, 16#110000]))}, + {"no negative codepoints", ?_assert(not is_string([$A, -1, 0]))} + ]}. +-endif. + + +%% --------------------------------------------------------------------- +%% Splitting a full node name into basename and hostname, +%% using 'localhost' as the default hostname + +split_node(N) when is_atom(N) -> split_node(atom_to_list(N)); +split_node(Cs) -> split_node_1(Cs, []). + +split_node_1([$@ | Cs], As) -> split_node_2(As, Cs); +split_node_1([C | Cs], As) -> split_node_1(Cs, [C | As]); +split_node_1([], As) -> split_node_2(As, "localhost"). + +split_node_2(As, Cs) -> + {list_to_atom(lists:reverse(As)), list_to_atom(Cs)}. + +%% --------------------------------------------------------------------- +%% Get the name of the containing function for a fun. (This is encoded +%% in the name of the generated function that implements the fun.) +fun_parent(F) -> + {module, M} = erlang:fun_info(F, module), + {name, N} = erlang:fun_info(F, name), + case erlang:fun_info(F, type) of + {type, external} -> + {arity, A} = erlang:fun_info(F, arity), + {M, N, A}; + {type, local} -> + [$-|S] = atom_to_list(N), + C1 = string:chr(S, $/), + C2 = string:chr(S, $-), + {M, list_to_atom(string:sub_string(S, 1, C1 - 1)), + list_to_integer(string:sub_string(S, C1 + 1, C2 - 1))} + end. + +-ifdef(TEST). +fun_parent_test() -> + {?MODULE,fun_parent_test,0} = fun_parent(fun () -> ok end). +-endif. + +%% --------------------------------------------------------------------- +%% Ye olde uniq function + +uniq([X, X | Xs]) -> uniq([X | Xs]); +uniq([X | Xs]) -> [X | uniq(Xs)]; +uniq([]) -> []. + +-ifdef(TEST). +uniq_test_() -> + {"uniq", + [?_assertError(function_clause, uniq(ok)), + ?_assertError(function_clause, uniq([1|2])), + ?_test([] = uniq([])), + ?_test([1,2,3] = uniq([1,2,3])), + ?_test([1,2,3] = uniq([1,2,2,3])), + ?_test([1,2,3,2,1] = uniq([1,2,2,3,2,2,1])), + ?_test([1,2,3] = uniq([1,1,1,2,2,2,3,3,3])), + ?_test(["1","2","3"] = uniq(["1","1","2","2","3","3"])) + ]}. +-endif. + +%% --------------------------------------------------------------------- +%% Replacement for os:cmd + +%% TODO: Better cmd support, especially on Windows (not much tested) +%% TODO: Can we capture stderr separately somehow? + +command(Cmd) -> + command(Cmd, ""). + +command(Cmd, Dir) -> + command(Cmd, Dir, []). + +command(Cmd, Dir, Env) -> + CD = if Dir =:= "" -> []; + true -> [{cd, Dir}] + end, + SetEnv = if Env =:= [] -> []; + true -> [{env, Env}] + end, + Opt = CD ++ SetEnv ++ [stream, exit_status, use_stdio, + stderr_to_stdout, in, eof], + P = open_port({spawn, Cmd}, Opt), + get_data(P, []). + +get_data(P, D) -> + receive + {P, {data, D1}} -> + get_data(P, [D1|D]); + {P, eof} -> + port_close(P), + receive + {P, {exit_status, N}} -> + {N, normalize(lists:flatten(lists:reverse(D)))} + end + end. + +normalize([$\r, $\n | Cs]) -> + [$\n | normalize(Cs)]; +normalize([$\r | Cs]) -> + [$\n | normalize(Cs)]; +normalize([C | Cs]) -> + [C | normalize(Cs)]; +normalize([]) -> + []. + +-ifdef(TEST). + +cmd_test_() -> + ([?_test({0, "hello\n"} = ?_cmd_("echo hello"))] + ++ case os:type() of + {unix, _} -> + unix_cmd_tests(); + {win32, _} -> + win32_cmd_tests(); + _ -> + [] + end). + +unix_cmd_tests() -> + [{"command execution, status, and output", + [?_cmd("echo hello"), + ?_assertCmdStatus(0, "true"), + ?_assertCmdStatus(1, "false"), + ?_assertCmd("true"), + ?_assertCmdOutput("hello\n", "echo hello"), + ?_assertCmdOutput("hello", "echo -n hello") + ]}, + {"file setup and cleanup", + setup, + fun () -> ?cmd("mktemp tmp.XXXXXXXX") end, + fun (File) -> ?cmd("rm " ++ File) end, + fun (File) -> + [?_assertCmd("echo xyzzy >" ++ File), + ?_assertCmdOutput("xyzzy\n", "cat " ++ File)] + end} + ]. + +win32_cmd_tests() -> + [{"command execution, status, and output", + [?_cmd("echo hello"), + ?_assertCmdOutput("hello\n", "echo hello") + ]} + ]. + +-endif. % TEST + + +%% --------------------------------------------------------------------- +%% Wrapper around file:path_consult + +%% @throws {file_read_error, {Reason::atom(), Message::string(), +%% fileName()}} + +consult_file(File) -> + case file:path_consult(["."]++code:get_path(), File) of + {ok, Data, _Path} -> + Data; + {error, Reason} -> + Msg = file:format_error(Reason), + throw({file_read_error, {Reason, Msg, File}}) + end. + +%% --------------------------------------------------------------------- +%% Wrapper around file:list_dir + +%% @throws {file_read_error, {Reason::atom(), Message::string(), +%% fileName()}} + +list_dir(Dir) -> + case file:list_dir(Dir) of + {ok, Fs} -> + Fs; + {error, Reason} -> + Msg = file:format_error(Reason), + throw({file_read_error, {Reason, Msg, Dir}}) + end. + +%% --------------------------------------------------------------------- +%% A trie for remembering and checking least specific cancelled events +%% (an empty list `[]' simply represents a stored empty list, i.e., all +%% events will match, while an empty tree means that no events match). + +trie_new() -> + gb_trees:empty(). + +trie_store([_ | _], []) -> + []; +trie_store([E | Es], T) -> + case gb_trees:lookup(E, T) of + none -> + if Es =:= [] -> + gb_trees:insert(E, [], T); + true -> + gb_trees:insert(E, trie_store(Es, gb_trees:empty()), + T) + end; + {value, []} -> + T; %% prefix already stored + {value, T1} -> + gb_trees:update(E, trie_store(Es, T1), T) + end; +trie_store([], _T) -> + []. + +trie_match([_ | _], []) -> + prefix; +trie_match([E | Es], T) -> + case gb_trees:lookup(E, T) of + none -> + no; + {value, []} -> + if Es =:= [] -> exact; + true -> prefix + end; + {value, T1} -> + trie_match(Es, T1) + end; +trie_match([], []) -> + exact; +trie_match([], _T) -> + no. + +-ifdef(TEST). + +trie_test_() -> + [{"basic representation", + [?_assert(trie_new() =:= gb_trees:empty()), + ?_assert(trie_store([1], trie_new()) + =:= gb_trees:insert(1, [], gb_trees:empty())), + ?_assert(trie_store([1,2], trie_new()) + =:= gb_trees:insert(1, + gb_trees:insert(2, [], + gb_trees:empty()), + gb_trees:empty())), + ?_assert([] =:= trie_store([1], [])), + ?_assert([] =:= trie_store([], gb_trees:empty())) + ]}, + {"basic storing and matching", + [?_test(no = trie_match([], trie_new())), + ?_test(exact = trie_match([], trie_store([], trie_new()))), + ?_test(no = trie_match([], trie_store([1], trie_new()))), + ?_test(exact = trie_match([1], trie_store([1], trie_new()))), + ?_test(prefix = trie_match([1,2], trie_store([1], trie_new()))), + ?_test(no = trie_match([1], trie_store([1,2], trie_new()))), + ?_test(no = trie_match([1,3], trie_store([1,2], trie_new()))), + ?_test(exact = trie_match([1,2,3,4,5], + trie_store([1,2,3,4,5], trie_new()))), + ?_test(prefix = trie_match([1,2,3,4,5], + trie_store([1,2,3], trie_new()))), + ?_test(no = trie_match([1,2,2,4,5], + trie_store([1,2,3], trie_new()))) + ]}, + {"matching with partially overlapping patterns", + setup, + fun () -> + trie_store([1,3,2], trie_store([1,2,3], trie_new())) + end, + fun (T) -> + [?_test(no = trie_match([], T)), + ?_test(no = trie_match([1], T)), + ?_test(no = trie_match([1,2], T)), + ?_test(no = trie_match([1,3], T)), + ?_test(exact = trie_match([1,2,3], T)), + ?_test(exact = trie_match([1,3,2], T)), + ?_test(no = trie_match([1,2,2], T)), + ?_test(no = trie_match([1,3,3], T)), + ?_test(prefix = trie_match([1,2,3,4], T)), + ?_test(prefix = trie_match([1,3,2,1], T))] + end}, + {"matching with more general pattern overriding less general", + setup, + fun () -> trie_store([1], trie_store([1,2,3], trie_new())) end, + fun (_) -> ok end, + fun (T) -> + [?_test(no = trie_match([], T)), + ?_test(exact = trie_match([1], T)), + ?_test(prefix = trie_match([1,2], T)), + ?_test(prefix = trie_match([1,2,3], T)), + ?_test(prefix = trie_match([1,2,3,4], T))] + end} + ]. + +-endif. % TEST diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl new file mode 100644 index 0000000000..20faecbf01 --- /dev/null +++ b/lib/eunit/src/eunit_listener.erl @@ -0,0 +1,178 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id$ +%% +%% @author Richard Carlsson +%% @copyright 2009 Richard Carlsson +%% @private +%% @see eunit +%% @doc Generic listener process for eunit. + +-module(eunit_listener). + +-define(NODEBUG, true). +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-export([start/1, start/2]). + +-export([behaviour_info/1]). + + +behaviour_info(callbacks) -> + [{init,1},{handle_begin,3},{handle_end,3},{handle_cancel,3}, + {terminate,2}]; +behaviour_info(_Other) -> + undefined. + + +-record(state, {callback, % callback module + pass = 0, + fail = 0, + skip = 0, + cancel = 0, + state % substate + }). + +start(Callback) -> + start(Callback, []). + +start(Callback, Options) -> + St = #state{callback = Callback}, + spawn_opt(fun () -> init(St, Options) end, + proplists:get_all_values(spawn, Options)). + +init(St0, Options) -> + St1 = call(init, [Options], St0), + St2 = expect([], undefined, St1), + Data = [{pass, St2#state.pass}, + {fail, St2#state.fail}, + {skip, St2#state.skip}, + {cancel, St2#state.cancel}], + call(terminate, [{ok, Data}, St2#state.state], St2), + exit(normal). + +expect(Id, ParentId, St) -> + case wait_for(Id, 'begin', ParentId) of + {done, Data} -> + {done, Data, St}; + {ok, Msg} -> + case Msg of + {group, Data} -> + group(Id, Data, St); + {test, Data} -> + St1 = handle_begin(test, Id, Data, St), + case wait_for(Id, 'end', ParentId) of + {cancel, Reason} -> + handle_cancel(test, Id, Data, Reason, St1); + {ok, Result} -> + handle_end(test, Id, Data, Result, St1) + end + end + end. + +%% collect group items in order until group is done +group(Id, Data, St) -> + St1 = handle_begin(group, Id, Data, St), + group_loop(0, Id, Data, St1). + +group_loop(N, Id, Data, St) -> + N1 = N + 1, + case expect(Id ++ [N1], Id, St) of + {done, {cancel, Reason}, St1} -> + handle_cancel(group, Id, Data, Reason, St1); + {done, Result, St1} -> + handle_end(group, Id, Data, Result, St1); + St1 -> + group_loop(N1, Id, Data, St1) + end. + +%% waiting for [..., M, N] begin +%% get: +%% [..., M, N] begin test -> expect [..., M, N] end (test begin) +%% [..., M, N] begin group -> expect [..., M, N, 1] end (group begin) +%% [..., M] end -> expect [..., M+1] begin (parent end) +%% cancel([..., M]) (parent cancel) +%% +%% waiting for [..., M, N] end +%% get: +%% [..., M, N] end -> expect [..., M, N+1] begin (seen end) +%% cancel([..., M, N]) (cancelled) + +wait_for(Id, Type, ParentId) -> + ?debugFmt("waiting for ~w ~w", [Id, Type]), + receive + {status, Id, {progress, Type, Data}} -> + ?debugFmt("got status ~w ~w", [Id, Data]), + {ok, Data}; + {status, ParentId, {progress, 'end', Data}} when Type =:= 'begin' -> + ?debugFmt("got parent end ~w ~w", [ParentId, Data]), + {done, Data}; + {status, Id, {cancel, Reason}} when Type =:= 'end' -> + ?debugFmt("got cancel ~w ~w", [Id, Reason]), + {cancel, Reason}; + {status, ParentId, {cancel, _Reason}} -> + ?debugFmt("got parent cancel ~w ~w", [ParentId, _Reason]), + {done, {cancel, _Reason}} + end. + +call(F, As, St) when is_atom(F) -> + try apply(St#state.callback, F, As) of + Substate -> St#state{state = Substate} + catch + Class:Term -> + Trace = erlang:get_stacktrace(), + if F =/= terminate -> + call(terminate, [{error, {Class, Term, Trace}}, + St#state.state], St); + true -> ok + end, + erlang:raise(Class, Term, Trace) + end. + +handle_begin(group, Id, Data0, St) -> + Data = [{id, Id} | Data0], + ?debugFmt("handle_begin group ~w ~w", [Id, Data0]), + call(handle_begin, [group, Data, St#state.state], St); +handle_begin(test, Id, Data0, St) -> + Data = [{id, Id} | Data0], + ?debugFmt("handle_begin test ~w ~w", [Id, Data0]), + call(handle_begin, [test, Data, St#state.state], St). + +handle_end(group, Id, Data0, {Count, Data1}, St) -> + Data = [{id, Id}, {size, Count} | Data0 ++ Data1], + ?debugFmt("handle_end group ~w ~w", [Id, {Count, Data1}]), + call(handle_end, [group, Data, St#state.state], St); +handle_end(test, Id, Data0, {Status, Data1}, St) -> + Data = [{id, Id}, {status, Status} | Data0 ++ Data1], + ?debugFmt("handle_end test ~w ~w", [Id, {Status, Data1}]), + St1 = case Status of + ok -> St#state{pass = St#state.pass + 1}; + {skipped,_} -> St#state{skip = St#state.skip + 1}; + {error,_} -> St#state{fail = St#state.fail + 1} + end, + call(handle_end, [test, Data, St#state.state], St1). + +handle_cancel(group, Id, Data0, Reason, St) -> + Data = [{id, Id}, {reason, Reason} | Data0], + ?debugFmt("handle_cancel group ~w ~w", [Id, Reason]), + call(handle_cancel, [group, Data, St#state.state], + St#state{cancel = St#state.cancel + 1}); +handle_cancel(test, Id, Data0, Reason, St) -> + Data = [{id, Id}, {reason, Reason} | Data0], + ?debugFmt("handle_cancel test ~w ~w", [Id, Reason]), + call(handle_cancel, [test, Data, St#state.state], + St#state{cancel = St#state.cancel + 1}). diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl new file mode 100644 index 0000000000..e2d51d8bd5 --- /dev/null +++ b/lib/eunit/src/eunit_proc.erl @@ -0,0 +1,661 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id$ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc Test runner process tree functions + +-module(eunit_proc). + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-export([start/4]). + +%% This must be exported; see new_group_leader/1 for details. +-export([group_leader_process/1]). + +-record(procstate, {ref, id, super, insulator, parent, order}). + + +%% Spawns test process and returns the process Pid; sends {done, +%% Reference, Pid} to caller when finished. See the function +%% wait_for_task/2 for details about the need for the reference. +%% +%% The `Super' process receives a stream of status messages; see +%% message_super/3 for details. + +start(Tests, Order, Super, Reference) + when is_pid(Super), is_reference(Reference) -> + St = #procstate{ref = Reference, + id = [], + super = Super, + order = Order}, + spawn_group(local, #group{tests = Tests}, St). + + +%% Status messages sent to the supervisor process. (A supervisor does +%% not have to act on these messages - it can e.g. just log them, or +%% even discard them.) Each status message has the following form: +%% +%% {status, Id, Info} +%% +%% where Id identifies the item that the message pertains to, and the +%% Info part can be one of: +%% +%% {progress, 'begin', {test | group, Data}} +%% indicates that the item has been entered, and what type it is; +%% Data is [{desc,binary()}, {source,Source}, {line,integer()}] for +%% a test, and [{desc,binary()}, {spawn,SpawnType}, +%% {order,OrderType}] for a group. +%% +%% {progress, 'end', {Status, Data}} +%% Status = 'ok' | {error, Exception} | {skipped, Cause} | integer() +%% Data = [{time,integer()}, {output,binary()}] +%% +%% where Time is measured in milliseconds and Output is the data +%% written to the standard output stream during the test; if +%% Status is {skipped, Cause}, then Cause is a term thrown from +%% eunit_test:run_testfun/1. For a group item, the Status field is +%% the number of immediate subitems of the group; this helps the +%% collation of results. Failure for groups is always signalled +%% through a cancel message, not through the Status field. +%% +%% {cancel, Descriptor} +%% where Descriptor can be: +%% timeout a timeout occurred +%% {blame, Id} forced to terminate because of item `Id' +%% {abort, Cause} the test or group failed to execute +%% {exit, Reason} the test process terminated unexpectedly +%% {startup, Reason} failed to start a remote test process +%% +%% where Cause is a term thrown from eunit_data:enter_context/4 or +%% from eunit_data:iter_next/2, and Reason is an exit term from a +%% crashed process +%% +%% Note that due to concurrent (and possibly distributed) execution, +%% there are *no* strict ordering guarantees on the status messages, +%% with one exception: a 'begin' message will always arrive before its +%% corresponding 'end' message. + +message_super(Id, Info, St) -> + St#procstate.super ! {status, Id, Info}. + + +%% @TODO implement synchronized mode for insulator/child execution + +%% Ideas for synchronized mode: +%% +%% * At each "program point", i.e., before entering a test, entering a +%% group, or leaving a group, the child will synchronize with the +%% insulator to make sure it is ok to proceed. +%% +%% * The insulator can receive controlling messages from higher up in +%% the hierarchy, telling it to pause, resume, single-step, repeat, etc. +%% +%% * Synchronization on entering/leaving groups is necessary in order to +%% get control over things such as subprocess creation/termination and +%% setup/cleanup, making it possible to, e.g., repeat all the tests +%% within a particular subprocess without terminating and restarting it, +%% or repeating tests without repeating the setup/cleanup. +%% +%% * Some tests that depend on state will not be possible to repeat, but +%% require a fresh context setup. There is nothing that can be done +%% about this, and the many tests that are repeatable should not be +%% punished because of it. The user must decide which level to restart. +%% +%% * Question: How propagate control messages down the hierarchy +%% (preferably only to the correct insulator process)? An insulator does +%% not currenctly know whether its child process has spawned subtasks. +%% (The "supervisor" process does not know the Pids of the controlling +%% insulator processes in the tree, and it probably should not be +%% responsible for this anyway.) + + +%% --------------------------------------------------------------------- +%% Process tree primitives + +%% A "task" consists of an insulator process and a child process which +%% handles the actual work. When the child terminates, the insulator +%% process sends {done, Reference, self()} to the process which started +%% the task (the "parent"). The child process is given a State record +%% which contains the process id:s of the parent, the insulator, and the +%% supervisor. + +%% @spec (Type, (#procstate{}) -> () -> term(), #procstate{}) -> pid() +%% Type = local | {remote, Node::atom()} + +start_task(Type, Fun, St0) -> + St = St0#procstate{parent = self()}, + %% (note: the link here is mainly to propagate signals *downwards*, + %% so that the insulator can detect if the process that started the + %% task dies before the task is done) + F = fun () -> insulator_process(Type, Fun, St) end, + case Type of + local -> + %% we assume (at least for now) that local spawns can never + %% fail in such a way that the process does not start, so a + %% new local insulator does not need to synchronize here + spawn_link(F); + {remote, Node} -> + Pid = spawn_link(Node, F), + %% See below for the need for the {ok, Reference, Pid} + %% message. + Reference = St#procstate.ref, + Monitor = erlang:monitor(process, Pid), + %% (the DOWN message is guaranteed to arrive after any + %% messages sent by the process itself) + receive + {ok, Reference, Pid} -> + Pid; + {'DOWN', Monitor, process, Pid, Reason} -> + %% send messages as if the insulator process was + %% started, but terminated on its own accord + Msg = {startup, Reason}, + message_super(St#procstate.id, {cancel, Msg}, St), + self() ! {done, Reference, Pid} + end, + erlang:demonitor(Monitor, [flush]), + Pid + end. + +%% Relatively simple, and hopefully failure-proof insulator process +%% (This is cleaner than temporarily setting up the caller to trap +%% signals, and does not affect the caller's mailbox or other state.) +%% +%% We assume that nobody does a 'kill' on an insulator process - if that +%% should happen, the test framework will hang since the insulator will +%% never send a reply; see below for more. +%% +%% Note that even if the insulator process itself never fails, it is +%% still possible that it does not start properly, if it is spawned +%% remotely (e.g., if the remote node is down). Therefore, remote +%% insulators must always immediately send an {ok, Reference, self()} +%% message to the parent as soon as it is spawned. + +%% @spec (Type, Fun::() -> term(), St::#procstate{}) -> ok +%% Type = local | {remote, Node::atom()} + +insulator_process(Type, Fun, St0) -> + process_flag(trap_exit, true), + Parent = St0#procstate.parent, + if Type =:= local -> ok; + true -> Parent ! {ok, St0#procstate.ref, self()} + end, + St = St0#procstate{insulator = self()}, + Child = spawn_link(fun () -> child_process(Fun(St), St) end), + insulator_wait(Child, Parent, [], St). + +%% Normally, child processes exit with the reason 'normal' even if the +%% executed tests failed (by throwing exceptions), since the tests are +%% executed within a try-block. Child processes can terminate abnormally +%% by the following reasons: +%% 1) an error in the processing of the test descriptors (a malformed +%% descriptor, failure in a setup, cleanup or initialization, a +%% missing module or function, or a failing generator function); +%% 2) an internal error in the test running framework itself; +%% 3) receiving a non-trapped error signal as a consequence of running +%% test code. +%% Those under point 1 are "expected errors", handled specially in the +%% protocol, while the other two are unexpected errors. (Since alt. 3 +%% implies that the test neither reported success nor failure, it can +%% never be considered "proper" behaviour of a test.) Abnormal +%% termination is reported to the supervisor process but otherwise does +%% not affect the insulator compared to normal termination. Child +%% processes can also be killed abruptly by their insulators, in case of +%% a timeout or if a parent process dies. +%% +%% The insulator is the group leader for the child process, and gets all +%% of its standard I/O. The output is buffered and associated with the +%% currently active test or group, and is sent along with the 'end' +%% progress message when the test or group has finished. + +insulator_wait(Child, Parent, Buf, St) -> + receive + {child, Child, Id, {'begin', Type, Data}} -> + message_super(Id, {progress, 'begin', {Type, Data}}, St), + insulator_wait(Child, Parent, [[] | Buf], St); + {child, Child, Id, {'end', Status, Time}} -> + Data = [{time, Time}, {output, buffer_to_binary(hd(Buf))}], + message_super(Id, {progress, 'end', {Status, Data}}, St), + insulator_wait(Child, Parent, tl(Buf), St); + {child, Child, Id, {skipped, Reason}} -> + %% this happens when a subgroup fails to enter the context + message_super(Id, {cancel, {abort, Reason}}, St), + insulator_wait(Child, Parent, Buf, St); + {child, Child, Id, {abort, Cause}} -> + %% this happens when the child code threw an internal + %% eunit_abort; the child process has already exited + exit_messages(Id, {abort, Cause}, St), + %% no need to wait for the {'EXIT',Child,_} message + terminate_insulator(St); + {io_request, Child, ReplyAs, Req} -> + %% we only collect output from the child process itself, not + %% from secondary processes, otherwise we get race problems; + %% however, each test runs its personal group leader that + %% funnels all output - see the run_test() function + Buf1 = io_request(Child, ReplyAs, Req, hd(Buf)), + insulator_wait(Child, Parent, [Buf1 | tl(Buf)], St); + {io_request, From, ReplyAs, Req} when is_pid(From) -> + %% (this shouldn't happen anymore, but we keep it safe) + %% just ensure the sender gets a reply; ignore the data + io_request(From, ReplyAs, Req, []), + insulator_wait(Child, Parent, Buf, St); + {timeout, Child, Id} -> + exit_messages(Id, timeout, St), + kill_task(Child, St); + {'EXIT', Child, normal} -> + terminate_insulator(St); + {'EXIT', Child, Reason} -> + exit_messages(St#procstate.id, {exit, Reason}, St), + terminate_insulator(St); + {'EXIT', Parent, _} -> + %% make sure child processes are cleaned up recursively + kill_task(Child, St) + end. + +kill_task(Child, St) -> + exit(Child, kill), + terminate_insulator(St). + +buffer_to_binary([B]) when is_binary(B) -> B; % avoid unnecessary copying +buffer_to_binary(Buf) -> list_to_binary(lists:reverse(Buf)). + +%% Unlinking before exit avoids polluting the parent process with exit +%% signals from the insulator. The child process is already dead here. + +terminate_insulator(St) -> + %% messaging/unlinking is ok even if the parent is already dead + Parent = St#procstate.parent, + Parent ! {done, St#procstate.ref, self()}, + unlink(Parent), + exit(normal). + +%% send cancel messages for the Id of the "causing" item, and also for +%% the Id of the insulator itself, if they are different +exit_messages(Id, Cause, St) -> + %% the message for the most specific Id is always sent first + message_super(Id, {cancel, Cause}, St), + case St#procstate.id of + Id -> ok; + Id1 -> message_super(Id1, {cancel, {blame, Id}}, St) + end. + +%% Child processes send all messages via the insulator to ensure proper +%% sequencing with timeouts and exit signals. + +message_insulator(Data, St) -> + St#procstate.insulator ! {child, self(), St#procstate.id, Data}. + +%% Timeout handling + +set_timeout(Time, St) -> + erlang:send_after(Time, St#procstate.insulator, + {timeout, self(), St#procstate.id}). + +clear_timeout(Ref) -> + erlang:cancel_timer(Ref). + +with_timeout(undefined, Default, F, St) -> + with_timeout(Default, F, St); +with_timeout(Time, _Default, F, St) -> + with_timeout(Time, F, St). + +with_timeout(infinity, F, _St) -> + %% don't start timers unnecessarily + {T0, _} = statistics(wall_clock), + Value = F(), + {T1, _} = statistics(wall_clock), + {Value, T1 - T0}; +with_timeout(Time, F, St) when is_integer(Time), Time > 16#FFFFffff -> + with_timeout(16#FFFFffff, F, St); +with_timeout(Time, F, St) when is_integer(Time), Time < 0 -> + with_timeout(0, F, St); +with_timeout(Time, F, St) when is_integer(Time) -> + Ref = set_timeout(Time, St), + {T0, _} = statistics(wall_clock), + try F() of + Value -> + %% we could also read the timer, but this is simpler + {T1, _} = statistics(wall_clock), + {Value, T1 - T0} + after + clear_timeout(Ref) + end. + +%% The normal behaviour of a child process is not to trap exit +%% signals. The testing framework is not dependent on this, however, so +%% the test code is allowed to enable signal trapping as it pleases. +%% Note that I/O is redirected to the insulator process. + +%% @spec (() -> term(), #procstate{}) -> ok + +child_process(Fun, St) -> + group_leader(St#procstate.insulator, self()), + try Fun() of + _ -> ok + catch + %% the only "normal" way for a child process to bail out (e.g, + %% when not being able to parse the test descriptor) is to throw + %% an {eunit_abort, Reason} exception; any other exception will + %% be reported as an unexpected termination of the test + {eunit_abort, Cause} -> + message_insulator({abort, Cause}, St), + exit(aborted) + end. + +-ifdef(TEST). +child_test_() -> + [{"test processes do not trap exit signals", + ?_assertMatch(false, process_flag(trap_exit, false))}]. +-endif. + +%% @throws abortException() +%% @type abortException() = {eunit_abort, Cause::term()} + +abort_task(Cause) -> + throw({eunit_abort, Cause}). + +%% Typically, the process that executes this code is not trapping +%% signals, but it might be - it is outside of our control, since test +%% code can enable or disable trapping at will. That we cannot rely on +%% process links here, is why the insulator process of a task must be +%% guaranteed to always send a reply before it terminates. +%% +%% The unique reference guarantees that we don't extract any message +%% from the mailbox unless it belongs to the test framework (and not to +%% the running tests) - it is not possible to use selective receive to +%% match only messages that are tagged with some pid out of a +%% dynamically varying set of pids. When the wait-loop terminates, no +%% such message should remain in the mailbox. + +wait_for_task(Pid, St) -> + wait_for_tasks(sets:from_list([Pid]), St). + +wait_for_tasks(PidSet, St) -> + case sets:size(PidSet) of + 0 -> + ok; + _ -> + %% (note that when we receive this message for some task, we + %% are guaranteed that the insulator process of the task has + %% already informed the supervisor about any anomalies) + Reference = St#procstate.ref, + receive + {done, Reference, Pid} -> + %% (if Pid is not in the set, del_element has no + %% effect, so this is always safe) + Rest = sets:del_element(Pid, PidSet), + wait_for_tasks(Rest, St) + end + end. + +%% --------------------------------------------------------------------- +%% Separate testing process + +%% TODO: Ability to stop after N failures. +%% TODO: Flow control, starting new job as soon as slot is available + +tests(T, St) -> + I = eunit_data:iter_init(T, St#procstate.id), + case St#procstate.order of + inorder -> tests_inorder(I, St); + inparallel -> tests_inparallel(I, 0, St); + {inparallel, N} when is_integer(N), N >= 0 -> + tests_inparallel(I, N, St) + end. + +set_id(I, St) -> + St#procstate{id = eunit_data:iter_id(I)}. + +tests_inorder(I, St) -> + tests_inorder(I, 0, St). + +tests_inorder(I, N, St) -> + case get_next_item(I) of + {T, I1} -> + handle_item(T, set_id(I1, St)), + tests_inorder(I1, N+1, St); + none -> + N % the return status of a group is the subtest count + end. + +tests_inparallel(I, K0, St) -> + tests_inparallel(I, 0, St, K0, K0, sets:new()). + +tests_inparallel(I, N, St, K, K0, Children) when K =< 0, K0 > 0 -> + wait_for_tasks(Children, St), + tests_inparallel(I, N, St, K0, K0, sets:new()); +tests_inparallel(I, N, St, K, K0, Children) -> + case get_next_item(I) of + {T, I1} -> + Child = spawn_item(T, set_id(I1, St)), + tests_inparallel(I1, N+1, St, K - 1, K0, + sets:add_element(Child, Children)); + none -> + wait_for_tasks(Children, St), + N % the return status of a group is the subtest count + end. + +%% this starts a new separate task for an inparallel-item (which might +%% be a group and in that case might cause yet another spawn in the +%% handle_group() function, but it might also be just a single test) +spawn_item(T, St0) -> + Fun = fun (St) -> + fun () -> handle_item(T, St) end + end, + %% inparallel-items are always spawned locally + start_task(local, Fun, St0). + +get_next_item(I) -> + try eunit_data:iter_next(I) + catch + Term -> abort_task(Term) + end. + +handle_item(T, St) -> + case T of + #test{} -> handle_test(T, St); + #group{} -> handle_group(T, St) + end. + +handle_test(T, St) -> + Data = [{desc, T#test.desc}, {source, T#test.location}, + {line, T#test.line}], + message_insulator({'begin', test, Data}, St), + + %% each test case runs under a fresh group leader process + G0 = group_leader(), + Runner = self(), + G1 = new_group_leader(Runner), + group_leader(G1, self()), + + %% run the actual test, handling timeouts and getting the total run + %% time of the test code (and nothing else) + {Status, Time} = with_timeout(T#test.timeout, ?DEFAULT_TEST_TIMEOUT, + fun () -> run_test(T) end, St), + + %% restore group leader, get the collected output, and re-emit it so + %% that it all seems to come from this process, and always comes + %% before the 'end' message for this test + group_leader(G0, self()), + Output = group_leader_sync(G1), + io:put_chars(Output), + + message_insulator({'end', Status, Time}, St), + ok. + +%% @spec (#test{}) -> ok | {error, eunit_lib:exception()} +%% | {skipped, eunit_test:wrapperError()} + +run_test(#test{f = F}) -> + try eunit_test:run_testfun(F) of + {ok, _Value} -> + %% just discard the return value + ok; + {error, Exception} -> + {error, Exception} + catch + throw:WrapperError -> {skipped, WrapperError} + end. + +set_group_order(#group{order = undefined}, St) -> + St; +set_group_order(#group{order = Order}, St) -> + St#procstate{order = Order}. + +handle_group(T, St0) -> + St = set_group_order(T, St0), + case T#group.spawn of + undefined -> + run_group(T, St); + Type -> + Child = spawn_group(Type, T, St), + wait_for_task(Child, St) + end. + +spawn_group(Type, T, St0) -> + Fun = fun (St) -> + fun () -> run_group(T, St) end + end, + start_task(Type, Fun, St0). + +run_group(T, St) -> + %% note that the setup/cleanup is outside the group timeout; if the + %% setup fails, we do not start any timers + Timeout = T#group.timeout, + Data = [{desc, T#group.desc}, {spawn, T#group.spawn}, + {order, T#group.order}], + message_insulator({'begin', group, Data}, St), + F = fun (G) -> enter_group(G, Timeout, St) end, + try with_context(T, F) of + {Status, Time} -> + message_insulator({'end', Status, Time}, St) + catch + %% a throw here can come from eunit_data:enter_context/4 or from + %% get_next_item/1; for context errors, report group as aborted, + %% but continue processing tests + {context_error, Why, Trace} -> + message_insulator({skipped, {Why, Trace}}, St) + end, + ok. + +enter_group(T, Timeout, St) -> + with_timeout(Timeout, ?DEFAULT_GROUP_TIMEOUT, + fun () -> tests(T, St) end, St). + +with_context(#group{context = undefined, tests = T}, F) -> + F(T); +with_context(#group{context = #context{} = C, tests = I}, F) -> + eunit_data:enter_context(C, I, F). + +%% Group leader process for test cases - collects I/O output requests. + +new_group_leader(Runner) -> + %% We must use spawn/3 here (with explicit module and function + %% name), because the 'current function' status of the group leader + %% is used by the UNDER_EUNIT macro (in eunit.hrl). If we spawn + %% using a fun, the current function will be 'erlang:apply/2' during + %% early process startup, which will fool the macro. + spawn_link(?MODULE, group_leader_process, [Runner]). + +group_leader_process(Runner) -> + group_leader_loop(Runner, infinity, []). + +group_leader_loop(Runner, Wait, Buf) -> + receive + {io_request, From, ReplyAs, Req} -> + P = process_flag(priority, normal), + %% run this part under normal priority always + Buf1 = io_request(From, ReplyAs, Req, Buf), + process_flag(priority, P), + group_leader_loop(Runner, Wait, Buf1); + stop -> + %% quitting time: make a minimal pause, go low on priority, + %% set receive-timeout to zero and schedule out again + receive after 2 -> ok end, + process_flag(priority, low), + group_leader_loop(Runner, 0, Buf); + _ -> + %% discard any other messages + group_leader_loop(Runner, Wait, Buf) + after Wait -> + %% no more messages and nothing to wait for; we ought to + %% have collected all immediately pending output now + process_flag(priority, normal), + Runner ! {self(), buffer_to_binary(Buf)} + end. + +group_leader_sync(G) -> + G ! stop, + receive + {G, Buf} -> Buf + end. + +%% Implementation of buffering I/O for group leader processes. (Note that +%% each batch of characters is just pushed on the buffer, so it needs to +%% be reversed when it is flushed.) + +io_request(From, ReplyAs, Req, Buf) -> + {Reply, Buf1} = io_request(Req, Buf), + io_reply(From, ReplyAs, Reply), + Buf1. + +io_reply(From, ReplyAs, Reply) -> + From ! {io_reply, ReplyAs, Reply}. + +io_request({put_chars, Chars}, Buf) -> + {ok, [Chars | Buf]}; +io_request({put_chars, M, F, As}, Buf) -> + try apply(M, F, As) of + Chars -> {ok, [Chars | Buf]} + catch + C:T -> {{error, {C,T,erlang:get_stacktrace()}}, Buf} + end; +io_request({put_chars, _Enc, Chars}, Buf) -> + io_request({put_chars, Chars}, Buf); +io_request({put_chars, _Enc, Mod, Func, Args}, Buf) -> + io_request({put_chars, Mod, Func, Args}, Buf); +io_request({get_chars, _Enc, _Prompt, _N}, Buf) -> + {eof, Buf}; +io_request({get_chars, _Prompt, _N}, Buf) -> + {eof, Buf}; +io_request({get_line, _Prompt}, Buf) -> + {eof, Buf}; +io_request({get_line, _Enc, _Prompt}, Buf) -> + {eof, Buf}; +io_request({get_until, _Prompt, _M, _F, _As}, Buf) -> + {eof, Buf}; +io_request({setopts, _Opts}, Buf) -> + {ok, Buf}; +io_request(getopts, Buf) -> + {error, {error, enotsup}, Buf}; +io_request({get_geometry,columns}, Buf) -> + {error, {error, enotsup}, Buf}; +io_request({get_geometry,rows}, Buf) -> + {error, {error, enotsup}, Buf}; +io_request({requests, Reqs}, Buf) -> + io_requests(Reqs, {ok, Buf}); +io_request(_, Buf) -> + {{error, request}, Buf}. + +io_requests([R | Rs], {ok, Buf}) -> + io_requests(Rs, io_request(R, Buf)); +io_requests(_, Result) -> + Result. diff --git a/lib/eunit/src/eunit_serial.erl b/lib/eunit/src/eunit_serial.erl new file mode 100644 index 0000000000..d9ccae86f9 --- /dev/null +++ b/lib/eunit/src/eunit_serial.erl @@ -0,0 +1,186 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id$ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc Event serializing and multiplexing process, to be used as the +%% main "supervisor" process for en EUnit test runner. See eunit_proc +%% for details about the events that will be sent to the listeners +%% (provided to this process at startup). This process guarantees that +%% listeners will receive events in order, even if tests execute in +%% parallel. For every received 'begin' event, there will be exactly one +%% 'end' or 'cancel' event. For a cancelling event with identifier Id, +%% no further events will arrive whose identifiers have Id as prefix. + +-module(eunit_serial). + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-export([start/1]). + +%% Notes: +%% * Due to concurrency, there are no guarantees that we will receive +%% all status messages for the items within a group before we receive +%% the 'end' message of the group itself. +%% +%% * A cancelling event may arrive at any time, and may concern items we +%% are not yet expecting (if tests are executed in parallel), or may +%% concern not only the current item but possibly a group ancestor of +%% the current item (as in the case of a group timeout). +%% +%% * It is not possible to use selective receive to extract only those +%% cancelling messages that affect the current item and its parents; +%% basically, because we cannot have a dynamically computed prefix as a +%% pattern in a receive. Hence, we must extract each cancelling event as +%% it arrives and keep track of them separately. +%% +%% * Before we wait for a new item, we must check whether it (and thus +%% also all its subitems, if any) is already cancelled. +%% +%% * When a new cancelling event arrives, we must either store it for +%% future use, and/or cancel the current item and possibly one or more +%% of its parent groups. + +-record(state, {listeners :: set(), + cancelled = eunit_lib:trie_new() :: gb_tree(), + messages = dict:new() :: dict()}). + +start(Pids) -> + spawn(fun () -> serializer(Pids) end). + +serializer(Pids) -> + St = #state{listeners = sets:from_list(Pids), + cancelled = eunit_lib:trie_new(), + messages = dict:new()}, + expect([], undefined, 0, St), + exit(normal). + +%% collect beginning and end of an expected item; return {Done, NewSt} +%% where Done is true if there are no more items of this group +expect(Id, ParentId, GroupMinSize, St0) -> + case wait(Id, 'begin', ParentId, GroupMinSize, St0) of + {done, St1} -> + {true, St1}; + {cancel, prefix, _Msg, St1} -> + %% if a parent caused the cancel, signal done with group and + %% cast no cancel event (since the item might not exist) + {true, St1}; + {cancel, exact, Msg, St1} -> + cast_cancel(Id, Msg, St1), + {false, St1}; + {ok, Msg, St1} -> + %%?debugVal({got_begin, Id, Msg}), + cast(Msg, St1), + St2 = case Msg of + {status, _, {progress, 'begin', {group, _Info}}} -> + group(Id, 0, St1); + _ -> + St1 + end, + case wait(Id, 'end', ParentId, GroupMinSize, St2) of + {cancel, Why, Msg1, St3} -> + %% we know the item exists, so always cast a cancel + %% event, and signal done with the group if a parent + %% caused the cancel + cast_cancel(Id, Msg1, St3), + {(Why =:= prefix), St3}; + {ok, Msg1, St3} -> + %%?debugVal({got_end, Id, Msg1}), + cast(Msg1, St3), + {false, St3} + end + end. + +%% collect group items in order until group is done +group(ParentId, GroupMinSize, St) -> + N = GroupMinSize + 1, + case expect(ParentId ++ [N], ParentId, GroupMinSize, St) of + {false, St1} -> + group(ParentId, N, St1); + {true, St1} -> + St1 + end. + +cast_cancel(Id, undefined, St) -> + %% reasonable message for implicitly cancelled events + cast({status, Id, {cancel, undefined}}, St); +cast_cancel(_Id, Msg, St) -> + cast(Msg, St). + +cast(Msg, St) -> + sets:fold(fun (L, M) -> L ! M end, Msg, St#state.listeners), + ok. + +%% wait for a particular begin or end event, that might have arrived or +%% been cancelled already, or might become cancelled later, or might not +%% even exist (for the last+1 element of a group) +wait(Id, Type, ParentId, GroupMinSize, St) -> + %%?debugVal({wait, Id, Type}), + case check_cancelled(Id, St) of + no -> + case recall(Id, St) of + undefined -> + wait_1(Id, Type, ParentId, GroupMinSize, St); + Msg -> + {ok, Msg, forget(Id, St)} + end; + Why -> + %%?debugVal({cancelled, Why, Id, ParentId}), + {cancel, Why, recall(Id, St), forget(Id, St)} + end. + +%% the event has not yet arrived or been cancelled - wait for more info +wait_1(Id, Type, ParentId, GroupMinSize, St) -> + receive + {status, Id, {progress, Type, _}}=Msg -> + %%?debugVal({Type, ParentId, Id}), + {ok, Msg, St}; + {status, ParentId, {progress, 'end', {GroupMinSize, _}}}=Msg -> + %% the parent group ended (the final status of a group is + %% the count of its subitems), and we have seen all of its + %% subtests, so the currently expected event does not exist + %%?debugVal({end_group, ParentId, Id, GroupMinSize}), + {done, remember(ParentId, Msg, St)}; + {status, SomeId, {cancel, _Cause}}=Msg -> + %%?debugVal({got_cancel, SomeId, _Cause}), + St1 = set_cancelled(SomeId, Msg, St), + wait(Id, Type, ParentId, GroupMinSize, St1) + end. + +set_cancelled(Id, Msg, St0) -> + St = remember(Id, Msg, St0), + St#state{cancelled = eunit_lib:trie_store(Id, St0#state.cancelled)}. + +check_cancelled(Id, St) -> + %% returns 'no', 'exact', or 'prefix' + eunit_lib:trie_match(Id, St#state.cancelled). + +remember(Id, Msg, St) -> + St#state{messages = dict:store(Id, Msg, St#state.messages)}. + +forget(Id, St) -> + %% this is just to enable garbage collection of old messages + St#state{messages = dict:store(Id, undefined, St#state.messages)}. + +recall(Id, St) -> + case dict:find(Id, St#state.messages) of + {ok, Msg} -> Msg; + error -> undefined + end. diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl new file mode 100644 index 0000000000..bf1bb9bcef --- /dev/null +++ b/lib/eunit/src/eunit_server.erl @@ -0,0 +1,341 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_server.erl 267 2008-10-19 18:48:03Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc EUnit server process + +-module(eunit_server). + +-export([start/1, stop/1, start_test/4, watch/3, watch_path/3, + watch_regexp/3]). + +-export([main/1]). % private + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + + +-define(AUTO_TIMEOUT, 60000). %% auto test time limit + +%% TODO: pass options to server, such as default timeout? + +start(Server) when is_atom(Server) -> + ensure_started(Server). + +stop(Server) -> + command(Server, stop). + + +-record(job, {super, test, options}). + +%% The `Super' process will receive a stream of status messages; see +%% eunit_proc:status_message/3 for details. + +start_test(Server, Super, T, Options) -> + command(Server, {start, #job{super = Super, + test = T, + options = Options}}). + +watch(Server, Module, Opts) when is_atom(Module) -> + command(Server, {watch, {module, Module}, Opts}). + +watch_path(Server, Path, Opts) -> + command(Server, {watch, {path, filename:flatten(Path)}, Opts}). + +watch_regexp(Server, Regex, Opts) -> + case regexp:parse(Regex) of + {ok, R} -> + command(Server, {watch, {regexp, R}, Opts}); + {error, _}=Error -> + Error + end. + +%% This makes sure the server is started before sending the command, and +%% returns {ok, Result} if the server accepted the command or {error, +%% server_down} if the server process crashes. If the server does not +%% reply, this function will wait until the server is killed. + +command(Server, Cmd) -> + if is_atom(Server), Cmd /= stop -> ensure_started(Server); + true -> ok + end, + if is_pid(Server) -> command_1(Server, Cmd); + true -> + case whereis(Server) of + undefined -> {error, server_down}; + Pid -> command_1(Pid, Cmd) + end + end. + +command_1(Pid, Cmd) when is_pid(Pid) -> + Pid ! {command, self(), Cmd}, + command_wait(Pid, 1000, undefined). + +command_wait(Pid, Timeout, Monitor) -> + receive + {Pid, Result} -> Result; + {'DOWN', Monitor, process, Pid, _R} -> {error, server_down} + after Timeout -> + %% avoid creating a monitor unless some time has passed + command_wait(Pid, infinity, erlang:monitor(process, Pid)) + end. + +%% Starting the server + +ensure_started(Name) -> + ensure_started(Name, 5). + +ensure_started(Name, N) when N > 0 -> + case whereis(Name) of + undefined -> + Parent = self(), + Pid = spawn(fun () -> server_start(Name, Parent) end), + receive + {Pid, ok} -> + Pid; + {Pid, error} -> + receive after 200 -> ensure_started(Name, N - 1) end + end; + Pid -> + Pid + end; +ensure_started(_, _) -> + throw(no_server). + +server_start(undefined = Name, Parent) -> + %% anonymous server + server_start_1(Name, Parent); +server_start(Name, Parent) -> + try register(Name, self()) of + true -> server_start_1(Name, Parent) + catch + _:_ -> + Parent ! {self(), error}, + exit(error) + end. + +server_start_1(Name, Parent) -> + Parent ! {self(), ok}, + server_init(Name). + +-record(state, {name, + stopped, + jobs, + queue, + auto_test, + modules, + paths, + regexps}). + +server_init(Name) -> + server(#state{name = Name, + stopped = false, + jobs = dict:new(), + queue = queue:new(), + auto_test = queue:new(), + modules = sets:new(), + paths = sets:new(), + regexps = sets:new()}). + +server(St) -> + server_check_exit(St), + ?MODULE:main(St). + +%% @private +main(St) -> + receive + {done, auto_test, _Pid} -> + server(auto_test_done(St)); + {done, Reference, _Pid} -> + server(handle_done(Reference, St)); + {command, From, _Cmd} when St#state.stopped -> + From ! {self(), stopped}; + {command, From, Cmd} -> + server_command(From, Cmd, St); + {code_monitor, {loaded, M, _Time}} -> + case is_watched(M, St) of + true -> + server(new_auto_test(self(), M, St)); + false -> + server(St) + end + end. + +server_check_exit(St) -> + case dict:size(St#state.jobs) of + 0 when St#state.stopped -> exit(normal); + _ -> ok + end. + +server_command(From, {start, Job}, St) -> + Reference = make_ref(), + St1 = case proplists:get_bool(enqueue, Job#job.options) of + true -> + enqueue(Job, From, Reference, St); + false -> + start_job(Job, From, Reference, St) + end, + server_command_reply(From, {ok, Reference}), + server(St1); +server_command(From, stop, St) -> + %% unregister the server name and let remaining jobs finish + server_command_reply(From, {error, stopped}), + catch unregister(St#state.name), + server(St#state{stopped = true}); +server_command(From, {watch, Target, _Opts}, St) -> + %% the code watcher is only started on demand + %% FIXME: this is disabled for now in the OTP distribution + %%code_monitor:monitor(self()), + %% TODO: propagate options to testing stage + St1 = add_watch(Target, St), + server_command_reply(From, ok), + server(St1); +server_command(From, {forget, Target}, St) -> + St1 = delete_watch(Target, St), + server_command_reply(From, ok), + server(St1); +server_command(From, Cmd, St) -> + server_command_reply(From, {error, {unknown_command, Cmd}}), + server(St). + +server_command_reply(From, Result) -> + From ! {self(), Result}. + +enqueue(Job, From, Reference, St) -> + case dict:size(St#state.jobs) of + 0 -> + start_job(Job, From, Reference, St); + _ -> + St#state{queue = queue:in({Job, From, Reference}, + St#state.queue)} + end. + +dequeue(St) -> + case queue:out(St#state.queue) of + {empty, _} -> + St; + {{value, {Job, From, Reference}}, Queue} -> + start_job(Job, From, Reference, St#state{queue = Queue}) + end. + +start_job(Job, From, Reference, St) -> + From ! {start, Reference}, + %% The default is to run tests in order unless otherwise specified + Order = proplists:get_value(order, Job#job.options, inorder), + eunit_proc:start(Job#job.test, Order, Job#job.super, Reference), + St#state{jobs = dict:store(Reference, From, St#state.jobs)}. + +handle_done(Reference, St) -> + case dict:find(Reference, St#state.jobs) of + {ok, From} -> + From ! {done, Reference}, + dequeue(St#state{jobs = dict:erase(Reference, + St#state.jobs)}); + error -> + St + end. + +%% Adding and removing watched modules or paths + +add_watch({module, M}, St) -> + St#state{modules = sets:add_element(M, St#state.modules)}; +add_watch({path, P}, St) -> + St#state{paths = sets:add_element(P, St#state.paths)}; +add_watch({regexp, R}, St) -> + St#state{regexps = sets:add_element(R, St#state.regexps)}. + +delete_watch({module, M}, St) -> + St#state{modules = sets:del_element(M, St#state.modules)}; +delete_watch({path, P}, St) -> + St#state{paths = sets:del_element(P, St#state.paths)}; +delete_watch({regexp, R}, St) -> + St#state{regexps = sets:del_element(R, St#state.regexps)}. + +%% Checking if a module is being watched + +is_watched(M, St) when is_atom(M) -> + sets:is_element(M, St#state.modules) orelse + is_watched(code:which(M), St); +is_watched(Path, St) -> + sets:is_element(filename:dirname(Path), St#state.paths) orelse + match_any(sets:to_list(St#state.regexps), Path). + +match_any([R | Rs], Str) -> + case regexp:first_match(Str, R) of + {match, _, _} -> true; + _ -> match_any(Rs, Str) + end; +match_any([], _Str) -> false. + +%% Running automatic tests when a watched module is loaded. +%% Uses a queue in order to avoid overlapping output when several +%% watched modules are loaded simultaneously. (The currently running +%% automatic test is kept in the queue until it is done. An empty queue +%% means that no automatic test is running.) + +new_auto_test(Server, M, St) -> + case queue:is_empty(St#state.auto_test) of + true -> + start_auto_test(Server, M); + false -> + ok + end, + St#state{auto_test = queue:in({Server, M}, St#state.auto_test)}. + +auto_test_done(St) -> + %% remove finished test from queue before checking for more + {_, Queue} = queue:out(St#state.auto_test), + case queue:out(Queue) of + {{value, {Server, M}}, _} -> + %% this is just lookahead - the item is not removed + start_auto_test(Server, M); + {empty, _} -> + ok + end, + St#state{auto_test = Queue}. + +start_auto_test(Server, M) -> + spawn(fun () -> auto_super(Server, M) end). + +auto_super(Server, M) -> + process_flag(trap_exit, true), + %% Give the user a short delay before any output is produced + receive after 333 -> ok end, + %% Make sure output is sent to console on server node + group_leader(whereis(user), self()), + Pid = spawn_link(fun () -> auto_proc(Server, M) end), + receive + {'EXIT', Pid, _} -> + ok + after ?AUTO_TIMEOUT -> + exit(Pid, kill), + io:put_chars("\n== EUnit: automatic test was aborted ==\n"), + io:put_chars("\n> ") + end, + Server ! {done, auto_test, self()}. + +auto_proc(Server, M) -> + %% Make the output start on a new line instead of on the same line + %% as the current shell prompt. + io:fwrite("\n== EUnit: testing module ~w ==\n", [M]), + eunit:test(Server, M, [enqueue]), + %% Make sure to print a dummy prompt at the end of the output, most + %% of all so that the Emacs mode realizes that input is active. + io:put_chars("\n-> "). diff --git a/lib/eunit/src/eunit_striptests.erl b/lib/eunit/src/eunit_striptests.erl new file mode 100644 index 0000000000..606e44b286 --- /dev/null +++ b/lib/eunit/src/eunit_striptests.erl @@ -0,0 +1,67 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_striptests.erl 329 2009-03-01 11:23:32Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @author Eric Merritt +%% @copyright 2006 Richard Carlsson, Eric Merritt +%% @private +%% @see eunit +%% @doc Parse transform for stripping EUnit test functions. + +-module(eunit_striptests). + +-include("eunit_internal.hrl"). + +-export([parse_transform/2]). + +parse_transform(Forms, Options) -> + TestSuffix = proplists:get_value(eunit_test_suffix, Options, + ?DEFAULT_TEST_SUFFIX), + GeneratorSuffix = proplists:get_value(eunit_generator_suffix, + Options, + ?DEFAULT_GENERATOR_SUFFIX), + ExportSuffix = proplists:get_value(eunit_export_suffix, Options, + ?DEFAULT_EXPORT_SUFFIX), + Exports = lists:foldl(fun ({attribute,_,export,Es}, S) -> + sets:union(sets:from_list(Es), S); + (_F, S) -> S + end, + sets:new(), Forms), + F = fun (Form, Acc) -> + form(Form, Acc, Exports, TestSuffix, GeneratorSuffix, + ExportSuffix) + end, + lists:reverse(lists:foldl(F, [], Forms)). + +form({function, _L, Name, 0, _Cs}=Form, Acc, Exports, TestSuffix, + GeneratorSuffix, ExportSuffix) -> + N = atom_to_list(Name), + case not sets:is_element({Name, 0}, Exports) + andalso (lists:suffix(TestSuffix, N) + orelse lists:suffix(GeneratorSuffix, N) + orelse lists:suffix(ExportSuffix, N)) + of + true -> + Acc; + false -> + [Form | Acc] + end; +form({function, _L, ?DEFAULT_MODULE_WRAPPER_NAME, 1, _Cs}, Acc, _, _, _, + _) -> + Acc; +form(Form, Acc, _, _, _, _) -> + [Form | Acc]. diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl new file mode 100644 index 0000000000..aeda31d251 --- /dev/null +++ b/lib/eunit/src/eunit_surefire.erl @@ -0,0 +1,417 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: $ +%% +%% @author Mickaël Rémond +%% @copyright 2009 Mickaël Rémond, Paul Guyot +%% @see eunit +%% @doc Surefire reports for EUnit (Format used by Maven and Atlassian +%% Bamboo for example to integrate test results). Based on initial code +%% from Paul Guyot. +%% +%% Example: Generate XML result file in the current directory: +%% ```eunit:test([fib, eunit_examples], +%% [{report,{eunit_surefire,[{dir,"."}]}}]).''' + +-module(eunit_surefire). + +-behaviour(eunit_listener). + +-define(NODEBUG, true). +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-export([start/0, start/1]). + +-export([init/1, handle_begin/3, handle_end/3, handle_cancel/3, + terminate/2]). + +%% ============================================================================ +%% MACROS +%% ============================================================================ +-define(XMLDIR, "."). +-define(INDENT, <<" ">>). +-define(NEWLINE, <<"\n">>). + +%% ============================================================================ +%% TYPES +%% ============================================================================ +-type(chars() :: [char() | any()]). % chars() + +%% ============================================================================ +%% RECORDS +%% ============================================================================ +-record(testcase, + { + name :: chars(), + description :: chars(), + result :: ok | {failed, tuple()} | {aborted, tuple()} | {skipped, tuple()}, + time :: integer(), + output :: binary() + }). +-record(testsuite, + { + name = <<>> :: binary(), + time = 0 :: integer(), + output = <<>> :: binary(), + succeeded = 0 :: integer(), + failed = 0 :: integer(), + aborted = 0 :: integer(), + skipped = 0 :: integer(), + testcases = [] :: [#testcase{}] + }). +-record(state, {verbose = false, + indent = 0, + xmldir = ".", + testsuite = #testsuite{} + }). + +start() -> + start([]). + +start(Options) -> + eunit_listener:start(?MODULE, Options). + +init(Options) -> + XMLDir = proplists:get_value(dir, Options, ?XMLDIR), + St = #state{verbose = proplists:get_bool(verbose, Options), + xmldir = XMLDir, + testsuite = #testsuite{}}, + receive + {start, _Reference} -> + St + end. + +terminate({ok, _Data}, St) -> + TestSuite = St#state.testsuite, + XmlDir = St#state.xmldir, + write_report(TestSuite, XmlDir), + ok; +terminate({error, Reason}, _St) -> + io:fwrite("Internal error: ~P.\n", [Reason, 25]), + sync_end(error). + +sync_end(Result) -> + receive + {stop, Reference, ReplyTo} -> + ReplyTo ! {result, Reference, Result}, + ok + end. + +handle_begin(group, Data, St) -> + NewId = proplists:get_value(id, Data), + case NewId of + [] -> + St; + [_GroupId] -> + Desc = proplists:get_value(desc, Data), + TestSuite = St#state.testsuite, + NewTestSuite = TestSuite#testsuite{name = Desc}, + St#state{testsuite=NewTestSuite}; + %% Surefire format is not hierarchic: Ignore subgroups: + _ -> + St + end; +handle_begin(test, _Data, St) -> + St. +handle_end(group, Data, St) -> + %% Retrieve existing test suite: + case proplists:get_value(id, Data) of + [] -> + St; + [_GroupId|_] -> + TestSuite = St#state.testsuite, + + %% Update TestSuite data: + Time = proplists:get_value(time, Data), + Output = proplists:get_value(output, Data), + NewTestSuite = TestSuite#testsuite{ time = Time, output = Output }, + St#state{testsuite=NewTestSuite} + end; +handle_end(test, Data, St) -> + %% Retrieve existing test suite: + TestSuite = St#state.testsuite, + + %% Create test case: + Name = format_name(proplists:get_value(source, Data), + proplists:get_value(line, Data)), + Desc = format_desc(proplists:get_value(desc, Data)), + Result = proplists:get_value(status, Data), + Time = proplists:get_value(time, Data), + Output = proplists:get_value(output, Data), + TestCase = #testcase{name = Name, description = Desc, + time = Time,output = Output}, + NewTestSuite = add_testcase_to_testsuite(Result, TestCase, TestSuite), + St#state{testsuite=NewTestSuite}. + +%% Cancel group does not give information on the individual cancelled test case +%% We ignore this event +handle_cancel(group, _Data, St) -> + St; +handle_cancel(test, Data, St) -> + %% Retrieve existing test suite: + TestSuite = St#state.testsuite, + + %% Create test case: + Name = format_name(proplists:get_value(source, Data), + proplists:get_value(line, Data)), + Desc = format_desc(proplists:get_value(desc, Data)), + Reason = proplists:get_value(reason, Data), + TestCase = #testcase{ + name = Name, description = Desc, + result = {skipped, Reason}, time = 0, + output = <<>>}, + NewTestSuite = TestSuite#testsuite{ + skipped = TestSuite#testsuite.skipped+1, + testcases=[TestCase|TestSuite#testsuite.testcases] }, + St#state{testsuite=NewTestSuite}. + +format_name({Module, Function, Arity}, Line) -> + lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", + integer_to_list(Arity), "_", integer_to_list(Line)]). +format_desc(undefined) -> + ""; +format_desc(Desc) when is_binary(Desc) -> + binary_to_list(Desc); +format_desc(Desc) when is_list(Desc) -> + Desc. + +%% Add testcase to testsuite depending on the result of the test. +add_testcase_to_testsuite(ok, TestCaseTmp, TestSuite) -> + TestCase = TestCaseTmp#testcase{ result = ok }, + TestSuite#testsuite{ + succeeded = TestSuite#testsuite.succeeded+1, + testcases=[TestCase|TestSuite#testsuite.testcases] }; +add_testcase_to_testsuite({error, Exception}, TestCaseTmp, TestSuite) -> + case Exception of + {error,{AssertionException,_},_} when + AssertionException == assertion_failed; + AssertionException == assertMatch_failed; + AssertionException == assertEqual_failed; + AssertionException == assertException_failed; + AssertionException == assertCmd_failed; + AssertionException == assertCmdOutput_failed + -> + TestCase = TestCaseTmp#testcase{ result = {failed, Exception} }, + TestSuite#testsuite{ + failed = TestSuite#testsuite.failed+1, + testcases = [TestCase|TestSuite#testsuite.testcases] }; + _ -> + TestCase = TestCaseTmp#testcase{ result = {aborted, Exception} }, + TestSuite#testsuite{ + aborted = TestSuite#testsuite.aborted+1, + testcases = [TestCase|TestSuite#testsuite.testcases] } + end. + +%% ---------------------------------------------------------------------------- +%% Write a report to the XML directory. +%% This function opens the report file, calls write_report_to/2 and closes the file. +%% ---------------------------------------------------------------------------- +write_report(#testsuite{name = Name} = TestSuite, XmlDir) -> + Filename = filename:join(XmlDir, lists:flatten(["TEST-", escape_suitename(Name)], ".xml")), + case file:open(Filename, [write, raw]) of + {ok, FileDescriptor} -> + try + write_report_to(TestSuite, FileDescriptor) + after + file:close(FileDescriptor) + end; + {error, _Reason} = Error -> throw(Error) + end. + +%% ---------------------------------------------------------------------------- +%% Actually write a report. +%% ---------------------------------------------------------------------------- +write_report_to(TestSuite, FileDescriptor) -> + write_header(FileDescriptor), + write_start_tag(TestSuite, FileDescriptor), + write_testcases(lists:reverse(TestSuite#testsuite.testcases), FileDescriptor), + write_end_tag(FileDescriptor). + +%% ---------------------------------------------------------------------------- +%% Write the XML header. +%% ---------------------------------------------------------------------------- +write_header(FileDescriptor) -> + file:write(FileDescriptor, [<<"">>, ?NEWLINE]). + +%% ---------------------------------------------------------------------------- +%% Write the testsuite start tag, with attributes describing the statistics +%% of the test suite. +%% ---------------------------------------------------------------------------- +write_start_tag( + #testsuite{ + name = Name, + time = Time, + succeeded = Succeeded, + failed = Failed, + skipped = Skipped, + aborted = Aborted}, + FileDescriptor) -> + Total = Succeeded + Failed + Skipped + Aborted, + StartTag = [ + <<">, integer_to_list(Total), + <<"\" failures=\"">>, integer_to_list(Failed), + <<"\" errors=\"">>, integer_to_list(Aborted), + <<"\" skipped=\"">>, integer_to_list(Skipped), + <<"\" time=\"">>, format_time(Time), + <<"\" name=\"">>, escape_attr(Name), + <<"\">">>, ?NEWLINE], + file:write(FileDescriptor, StartTag). + +%% ---------------------------------------------------------------------------- +%% Recursive function to write the test cases. +%% ---------------------------------------------------------------------------- +write_testcases([], _FileDescriptor) -> void; +write_testcases([TestCase| Tail], FileDescriptor) -> + write_testcase(TestCase, FileDescriptor), + write_testcases(Tail, FileDescriptor). + +%% ---------------------------------------------------------------------------- +%% Write the testsuite end tag. +%% ---------------------------------------------------------------------------- +write_end_tag(FileDescriptor) -> + file:write(FileDescriptor, [<<"">>, ?NEWLINE]). + +%% ---------------------------------------------------------------------------- +%% Write a test case, as a testcase tag. +%% If the test case was successful and if there was no output, we write an empty +%% tag. +%% ---------------------------------------------------------------------------- +write_testcase( + #testcase{ + name = Name, + description = Description, + result = Result, + time = Time, + output = Output}, + FileDescriptor) -> + DescriptionAttr = case Description of + <<>> -> []; + [] -> []; + _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>] + end, + StartTag = [ + ?INDENT, <<">, format_time(Time), + <<"\" name=\"">>, escape_attr(Name), <<"\"">>, + DescriptionAttr], + ContentAndEndTag = case {Result, Output} of + {ok, []} -> [<<"/>">>, ?NEWLINE]; + {ok, <<>>} -> [<<"/>">>, ?NEWLINE]; + _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"">>, ?NEWLINE] + end, + file:write(FileDescriptor, [StartTag, ContentAndEndTag]). + +%% ---------------------------------------------------------------------------- +%% Format the result of the test. +%% Failed tests are represented with a failure tag. +%% Aborted tests are represented with an error tag. +%% Skipped tests are represented with a skipped tag. +%% ---------------------------------------------------------------------------- +format_testcase_result(ok) -> [<<>>]; +format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) -> + [?INDENT, ?INDENT, <<">, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE, + <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({failed, Term}) -> + [?INDENT, ?INDENT, <<"">>, ?NEWLINE, + escape_text(io_lib:write(Term)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) -> + [?INDENT, ?INDENT, <<">, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE, + <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({aborted, Term}) -> + [?INDENT, ?INDENT, <<"">>, ?NEWLINE, + escape_text(io_lib:write(Term)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({skipped, {abort, Error}}) when is_tuple(Error) -> + [?INDENT, ?INDENT, <<">, escape_attr(atom_to_list(element(1, Error))), <<"\">">>, ?NEWLINE, + escape_text(eunit_lib:format_error(Error)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({skipped, {Type, Term}}) when is_atom(Type) -> + [?INDENT, ?INDENT, <<">, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE, + escape_text(io_lib:write(Term)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({skipped, timeout}) -> + [?INDENT, ?INDENT, <<"">>, ?NEWLINE]; +format_testcase_result({skipped, Term}) -> + [?INDENT, ?INDENT, <<"">>, ?NEWLINE, + escape_text(io_lib:write(Term)), + ?INDENT, ?INDENT, <<"">>, ?NEWLINE]. + +%% ---------------------------------------------------------------------------- +%% Format the output of a test case in xml. +%% Empty output is simply the empty string. +%% Other output is inside a xml tag. +%% ---------------------------------------------------------------------------- +format_testcase_output([]) -> []; +format_testcase_output(Output) -> + [?INDENT, ?INDENT, <<"">>, escape_text(Output), ?NEWLINE, ?INDENT, ?INDENT, <<"">>, ?NEWLINE]. + +%% ---------------------------------------------------------------------------- +%% Return the time in the SECS.MILLISECS format. +%% ---------------------------------------------------------------------------- +format_time(Time) -> + format_time_s(lists:reverse(integer_to_list(Time))). +format_time_s([Digit]) -> ["0.00", Digit]; +format_time_s([Digit1, Digit2]) -> ["0.0", Digit2, Digit1]; +format_time_s([Digit1, Digit2, Digit3]) -> ["0.", Digit3, Digit2, Digit1]; +format_time_s([Digit1, Digit2, Digit3 | Tail]) -> [lists:reverse(Tail), $., Digit3, Digit2, Digit1]. + +%% ---------------------------------------------------------------------------- +%% Escape a suite's name to generate the filename. +%% Remark: we might overwrite another testsuite's file. +%% ---------------------------------------------------------------------------- +escape_suitename([Head | _T] = List) when is_list(Head) -> + escape_suitename(lists:flatten(List)); +escape_suitename(Binary) when is_binary(Binary) -> + escape_suitename(binary_to_list(Binary)); +escape_suitename("module '" ++ String) -> + escape_suitename(String); +escape_suitename(String) -> + escape_suitename(String, []). + +escape_suitename(Binary, Acc) when is_binary(Binary) -> escape_suitename(binary_to_list(Binary), Acc); +escape_suitename([], Acc) -> lists:reverse(Acc); +escape_suitename([$ | Tail], Acc) -> escape_suitename(Tail, [$_ | Acc]); +escape_suitename([$' | Tail], Acc) -> escape_suitename(Tail, Acc); +escape_suitename([$/ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]); +escape_suitename([$\\ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]); +escape_suitename([Char | Tail], Acc) when Char < $! -> escape_suitename(Tail, Acc); +escape_suitename([Char | Tail], Acc) when Char > $~ -> escape_suitename(Tail, Acc); +escape_suitename([Char | Tail], Acc) -> escape_suitename(Tail, [Char | Acc]). + +%% ---------------------------------------------------------------------------- +%% Escape text for XML text nodes. +%% Replace < with <, > with > and & with & +%% ---------------------------------------------------------------------------- +escape_text(Text) when is_binary(Text) -> escape_text(binary_to_list(Text)); +escape_text(Text) -> escape_xml(lists:flatten(Text), [], false). + + +%% ---------------------------------------------------------------------------- +%% Escape text for XML attribute nodes. +%% Replace < with <, > with > and & with & +%% ---------------------------------------------------------------------------- +escape_attr(Text) when is_binary(Text) -> escape_attr(binary_to_list(Text)); +escape_attr(Text) -> escape_xml(lists:flatten(Text), [], true). + +escape_xml([], Acc, _ForAttr) -> lists:reverse(Acc); +escape_xml([$< | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $l, $& | Acc], ForAttr); +escape_xml([$> | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $g, $& | Acc], ForAttr); +escape_xml([$& | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $p, $m, $a, $& | Acc], ForAttr); +escape_xml([$" | Tail], Acc, true) -> escape_xml(Tail, [$;, $t, $o, $u, $q, $& | Acc], true); % " +escape_xml([Char | Tail], Acc, ForAttr) when is_integer(Char) -> escape_xml(Tail, [Char | Acc], ForAttr). diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl new file mode 100644 index 0000000000..d322c4b420 --- /dev/null +++ b/lib/eunit/src/eunit_test.erl @@ -0,0 +1,320 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_test.erl 336 2009-03-06 14:43:21Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @copyright 2006 Richard Carlsson +%% @private +%% @see eunit +%% @doc Test running functionality + +-module(eunit_test). + +-export([run_testfun/1, function_wrapper/2, enter_context/4, + multi_setup/1]). + + +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + + +%% --------------------------------------------------------------------- +%% Getting a cleaned up stack trace. (We don't want it to include +%% eunit's own internal functions. This complicates self-testing +%% somewhat, but you can't have everything.) Note that we assume that +%% this particular module is the boundary between eunit and user code. + +get_stacktrace() -> + get_stacktrace([]). + +get_stacktrace(Ts) -> + eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). + +prune_trace([{eunit_data, _, _} | Rest], Tail) -> + prune_trace(Rest, Tail); +prune_trace([{?MODULE, _, _} | _Rest], Tail) -> + Tail; +prune_trace([T | Ts], Tail) -> + [T | prune_trace(Ts, Tail)]; +prune_trace([], Tail) -> + Tail. + + +%% --------------------------------------------------------------------- +%% Test runner + +%% @spec ((any()) -> any()) -> {ok, Value} | {error, eunit_lib:exception()} +%% @throws wrapperError() + +run_testfun(F) -> + try + F() + of Value -> + {ok, Value} + catch + {eunit_internal, Term} -> + %% Internally generated: re-throw Term (lose the trace) + throw(Term); + Class:Reason -> + {error, {Class, Reason, get_stacktrace()}} + end. + + +-ifdef(TEST). +macro_test_() -> + {"macro definitions", + [{?LINE, fun () -> + {?LINE, F} = ?_test(undefined), + {ok, undefined} = run_testfun(F) + end}, + ?_test(begin + {?LINE, F} = ?_assert(true), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assert(false), + {error,{error,{assertion_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,true}, + {value,false}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assert([]), + {error,{error,{assertion_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,true}, + {value,{not_a_boolean,[]}}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNot(false), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertNot(true), + {error,{error,{assertion_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,true}, + {value,false}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertMatch(ok, ok), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertMatch([_], []), + {error,{error,{assertMatch_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,"[ _ ]"}, + {value,[]}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertEqual(ok, ok), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertEqual(3, 1+1), + {error,{error,{assertEqual_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,3}, + {value,2}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertException(error, badarith, + erlang:error(badarith)), + {ok, ok} = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertException(error, badarith, ok), + {error,{error,{assertException_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,_}, + {unexpected_success,ok}]}, + _}} + = run_testfun(F) + end), + ?_test(begin + {?LINE, F} = ?_assertException(error, badarg, + erlang:error(badarith)), + {error,{error,{assertException_failed, + [{module,_}, + {line,_}, + {expression,_}, + {expected,_}, + {unexpected_exception, + {error,badarith,_}}]}, + _}} + = run_testfun(F) + end) + ]}. + +under_eunit_test() -> ?assert(?UNDER_EUNIT). +-endif. + + +%% --------------------------------------------------------------------- +%% Wrapper for simple "named function" tests ({M,F}), which provides +%% better error reporting when the function is missing at test time. +%% +%% Note that the wrapper fun is usually called by run_testfun/1, and the +%% special exceptions thrown here are expected to be handled there. +%% +%% @throws {eunit_internal, wrapperError()} +%% +%% @type wrapperError() = {no_such_function, mfa()} +%% | {module_not_found, moduleName()} + +function_wrapper(M, F) -> + fun () -> + try M:F() + catch + error:undef -> + %% Check if it was M:F/0 that was undefined + case erlang:module_loaded(M) of + false -> + fail({module_not_found, M}); + true -> + case erlang:function_exported(M, F, 0) of + false -> + fail({no_such_function, {M,F,0}}); + true -> + rethrow(error, undef, [{M,F,0}]) + end + end + end + end. + +rethrow(Class, Reason, Trace) -> + erlang:raise(Class, Reason, get_stacktrace(Trace)). + +fail(Term) -> + throw({eunit_internal, Term}). + + +-ifdef(TEST). +wrapper_test_() -> + {"error handling in function wrapper", + [?_assertException(throw, {module_not_found, eunit_nonexisting}, + run_testfun(function_wrapper(eunit_nonexisting,test))), + ?_assertException(throw, + {no_such_function, {?MODULE,nonexisting_test,0}}, + run_testfun(function_wrapper(?MODULE,nonexisting_test))), + ?_test({error, {error, undef, _T}} + = run_testfun(function_wrapper(?MODULE,wrapper_test_exported_))) + ]}. + +%% this must be exported (done automatically by the autoexport transform) +wrapper_test_exported_() -> + {ok, ?MODULE:nonexisting_function()}. +-endif. + + +%% --------------------------------------------------------------------- +%% Entering a setup-context, with guaranteed cleanup. + +%% @spec (Setup, Cleanup, Instantiate, Callback) -> any() +%% Setup = () -> any() +%% Cleanup = (any()) -> any() +%% Instantiate = (any()) -> tests() +%% Callback = (tests()) -> any() +%% @throws {context_error, Error, eunit_lib:exception()} +%% Error = setup_failed | instantiation_failed | cleanup_failed + +enter_context(Setup, Cleanup, Instantiate, Callback) -> + try Setup() of + R -> + try Instantiate(R) of + T -> + try Callback(T) %% call back to client code + after + %% Always run cleanup; client may be an idiot + try Cleanup(R) + catch + Class:Term -> + context_error(cleanup_failed, Class, Term) + end + end + catch + Class:Term -> + context_error(instantiation_failed, Class, Term) + end + catch + Class:Term -> + context_error(setup_failed, Class, Term) + end. + +context_error(Type, Class, Term) -> + throw({context_error, Type, {Class, Term, get_stacktrace()}}). + +%% This generates single setup/cleanup functions from a list of tuples +%% on the form {Tag, Setup, Cleanup}, where the setup function always +%% backs out correctly from partial completion. + +multi_setup(List) -> + {SetupAll, CleanupAll} = multi_setup(List, fun ok/1), + %% must reverse back and forth here in order to present the list in + %% "natural" order to the test instantiation function + {fun () -> lists:reverse(SetupAll([])) end, + fun (Rs) -> CleanupAll(lists:reverse(Rs)) end}. + +multi_setup([{Tag, S, C} | Es], CleanupPrev) -> + Cleanup = fun ([R | Rs]) -> + try C(R) of + _ -> CleanupPrev(Rs) + catch + Class:Term -> + throw({Tag, {Class, Term, get_stacktrace()}}) + end + end, + {SetupRest, CleanupAll} = multi_setup(Es, Cleanup), + {fun (Rs) -> + try S() of + R -> + SetupRest([R|Rs]) + catch + Class:Term -> + CleanupPrev(Rs), + throw({Tag, {Class, Term, get_stacktrace()}}) + end + end, + CleanupAll}; +multi_setup([{Tag, S} | Es], CleanupPrev) -> + multi_setup([{Tag, S, fun ok/1} | Es], CleanupPrev); +multi_setup([], CleanupAll) -> + {fun (Rs) -> Rs end, CleanupAll}. + +ok(_) -> ok. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl new file mode 100644 index 0000000000..37c0b4d6ae --- /dev/null +++ b/lib/eunit/src/eunit_tests.erl @@ -0,0 +1,42 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_tests.erl 238 2007-11-15 10:23:54Z mremond $ +%% +%% @author Richard Carlsson +%% @copyright 2007 Richard Carlsson +%% @private +%% @see eunit +%% @doc External tests for eunit.erl + +-module(eunit_tests). + +-include("eunit.hrl"). + +-ifdef(TEST). +%% Cause all the other modules to be tested as well as this one. +full_test_() -> + %%{application, eunit}. % this currently causes a loop + %% We use the below until loop detection is implemented + [eunit_autoexport, + eunit_striptests, + eunit_server, + eunit_proc, + eunit_serial, + eunit_test, + eunit_lib, + eunit_data, + eunit_tty]. +-endif. diff --git a/lib/eunit/src/eunit_tty.erl b/lib/eunit/src/eunit_tty.erl new file mode 100644 index 0000000000..5fe0140559 --- /dev/null +++ b/lib/eunit/src/eunit_tty.erl @@ -0,0 +1,257 @@ +%% This library is free software; you can redistribute it and/or modify +%% it under the terms of the GNU Lesser General Public License as +%% published by the Free Software Foundation; either version 2 of the +%% License, or (at your option) any later version. +%% +%% This library is distributed in the hope that it will be useful, but +%% WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%% Lesser General Public License for more details. +%% +%% You should have received a copy of the GNU Lesser General Public +%% License along with this library; if not, write to the Free Software +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +%% USA +%% +%% $Id: eunit_tty.erl 330 2009-03-01 16:28:02Z rcarlsson $ +%% +%% @author Richard Carlsson +%% @copyright 2006-2009 Richard Carlsson +%% @private +%% @see eunit +%% @doc Text-based frontend for EUnit + +-module(eunit_tty). + +-behaviour(eunit_listener). + +-define(NODEBUG, true). +-include("eunit.hrl"). +-include("eunit_internal.hrl"). + +-export([start/0, start/1]). + +-export([init/1, handle_begin/3, handle_end/3, handle_cancel/3, + terminate/2]). + +-record(state, {verbose = false, + indent = 0 + }). + +start() -> + start([]). + +start(Options) -> + eunit_listener:start(?MODULE, Options). + +init(Options) -> + St = #state{verbose = proplists:get_bool(verbose, Options)}, + receive + {start, _Reference} -> + if St#state.verbose -> print_header(); + true -> ok + end, + St + end. + +terminate({ok, Data}, St) -> + Pass = proplists:get_value(pass, Data, 0), + Fail = proplists:get_value(fail, Data, 0), + Skip = proplists:get_value(skip, Data, 0), + Cancel = proplists:get_value(cancel, Data, 0), + if Fail =:= 0, Skip =:= 0, Cancel =:= 0 -> + if Pass =:= 0 -> + io:fwrite(" There were no tests to run.\n"); + true -> + if St#state.verbose -> print_bar(); + true -> ok + end, + if Pass =:= 1 -> + io:fwrite(" Test passed.\n"); + true -> + io:fwrite(" All ~w tests passed.\n", [Pass]) + end + end, + sync_end(ok); + true -> + print_bar(), + io:fwrite(" Failed: ~w. Skipped: ~w. Passed: ~w.\n", + [Fail, Skip, Pass]), + if Cancel =/= 0 -> + io:fwrite("One or more tests were cancelled.\n"); + true -> ok + end, + sync_end(error) + end; +terminate({error, Reason}, _St) -> + io:fwrite("Internal error: ~P.\n", [Reason, 25]), + sync_end(error). + +sync_end(Result) -> + receive + {stop, Reference, ReplyTo} -> + ReplyTo ! {result, Reference, Result}, + ok + end. + +print_header() -> + io:fwrite("======================== EUnit ========================\n"). + +print_bar() -> + io:fwrite("=======================================================\n"). + + +handle_begin(group, Data, St) -> + ?debugFmt("handle_begin group ~w", [Data]), + Desc = proplists:get_value(desc, Data), + if Desc =/= "", Desc =/= undefined, St#state.verbose -> + I = St#state.indent, + print_group_start(I, Desc), + St#state{indent = I + 1}; + true -> + St + end; +handle_begin(test, Data, St) -> + ?debugFmt("handle_begin test ~w", [Data]), + if St#state.verbose -> print_test_begin(St#state.indent, Data); + true -> ok + end, + St. + +handle_end(group, Data, St) -> + ?debugFmt("handle_end group ~w", [Data]), + Desc = proplists:get_value(desc, Data), + if Desc =/= "", Desc =/= undefined, St#state.verbose -> + Time = proplists:get_value(time, Data), + I = St#state.indent, + print_group_end(I, Time), + St#state{indent = I - 1}; + true -> + St + end; +handle_end(test, Data, St) -> + ?debugFmt("handle_end test ~w", [Data]), + case proplists:get_value(status, Data) of + ok -> + if St#state.verbose -> print_test_end(Data); + true -> ok + end, + St; + Status -> + if St#state.verbose -> ok; + true -> print_test_begin(St#state.indent, Data) + end, + print_test_error(Status, Data), + St + end. + +handle_cancel(group, Data, St) -> + ?debugFmt("handle_cancel group ~w", [Data]), + I = St#state.indent, + case proplists:get_value(reason, Data) of + undefined -> + %% "skipped" message is not interesting here + St#state{indent = I - 1}; + Reason -> + Desc = proplists:get_value(desc, Data), + if Desc =/= "", Desc =/= undefined, St#state.verbose -> + print_group_cancel(I, Reason); + true -> + print_group_start(I, Desc), + print_group_cancel(I, Reason) + end, + St#state{indent = I - 1} + end; +handle_cancel(test, Data, St) -> + ?debugFmt("handle_cancel test ~w", [Data]), + if St#state.verbose -> ok; + true -> print_test_begin(St#state.indent, Data) + end, + print_test_cancel(proplists:get_value(reason, Data)), + St. + + +indent(N) when is_integer(N), N >= 1 -> + io:put_chars(lists:duplicate(N * 2, $\s)); +indent(_N) -> + ok. + +print_group_start(I, Desc) -> + indent(I), + io:fwrite("~s\n", [Desc]). + +print_group_end(I, Time) -> + if Time > 0 -> + indent(I), + io:fwrite("[done in ~.3f s]\n", [Time/1000]); + true -> + ok + end. + +print_test_begin(I, Data) -> + Desc = proplists:get_value(desc, Data), + Line = proplists:get_value(line, Data, 0), + indent(I), + L = if Line =:= 0 -> ""; + true -> io_lib:fwrite("~w:", [Line]) + end, + D = if Desc =:= "" ; Desc =:= undefined -> ""; + true -> io_lib:fwrite(" (~s)", [Desc]) + end, + case proplists:get_value(source, Data) of + {Module, Name, _Arity} -> + io:fwrite("~s:~s ~s~s...", [Module, L, Name, D]); + _ -> + io:fwrite("~s~s...", [L, D]) + end. + +print_test_end(Data) -> + Time = proplists:get_value(time, Data, 0), + T = if Time > 0 -> io_lib:fwrite("[~.3f s] ", [Time/1000]); + true -> "" + end, + io:fwrite("~sok\n", [T]). + +print_test_error({error, Exception}, Data) -> + Output = proplists:get_value(output, Data), + io:fwrite("*failed*\n::~s", + [eunit_lib:format_exception(Exception)]), + case Output of + <<>> -> + io:put_chars("\n\n"); + <> -> + io:fwrite(" output:<<\"~s\">>...\n\n", [Text]); + _ -> + io:fwrite(" output:<<\"~s\">>\n\n", [Output]) + end; +print_test_error({skipped, Reason}, _) -> + io:fwrite("*did not run*\n::~s\n", [format_skipped(Reason)]). + +format_skipped({module_not_found, M}) -> + io_lib:format("missing module: ~w", [M]); +format_skipped({no_such_function, {M,F,A}}) -> + io_lib:format("no such function: ~w:~w/~w", [M,F,A]). + +print_test_cancel(Reason) -> + io:fwrite(format_cancel(Reason)). + +print_group_cancel(_I, {blame, _}) -> + ok; +print_group_cancel(I, Reason) -> + indent(I), + io:fwrite(format_cancel(Reason)). + +format_cancel(undefined) -> + "*skipped*\n"; +format_cancel(timeout) -> + "*timed out*\n"; +format_cancel({startup, Reason}) -> + io_lib:fwrite("*could not start test process*\n::~P\n\n", + [Reason, 15]); +format_cancel({blame, _SubId}) -> + "*cancelled because of subtask*\n"; +format_cancel({exit, Reason}) -> + io_lib:fwrite("*unexpected termination of test process*\n::~P\n\n", + [Reason, 15]); +format_cancel({abort, Reason}) -> + eunit_lib:format_error(Reason). -- cgit v1.2.3