aboutsummaryrefslogtreecommitdiffstats
path: root/lib/eunit/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/eunit/src')
-rw-r--r--lib/eunit/src/Makefile113
-rw-r--r--lib/eunit/src/eunit.app.src21
-rw-r--r--lib/eunit/src/eunit.appup.src1
-rw-r--r--lib/eunit/src/eunit.erl250
-rw-r--r--lib/eunit/src/eunit_autoexport.erl104
-rw-r--r--lib/eunit/src/eunit_data.erl732
-rw-r--r--lib/eunit/src/eunit_internal.hrl48
-rw-r--r--lib/eunit/src/eunit_lib.erl576
-rw-r--r--lib/eunit/src/eunit_listener.erl178
-rw-r--r--lib/eunit/src/eunit_proc.erl661
-rw-r--r--lib/eunit/src/eunit_serial.erl186
-rw-r--r--lib/eunit/src/eunit_server.erl341
-rw-r--r--lib/eunit/src/eunit_striptests.erl67
-rw-r--r--lib/eunit/src/eunit_surefire.erl417
-rw-r--r--lib/eunit/src/eunit_test.erl320
-rw-r--r--lib/eunit/src/eunit_tests.erl42
-rw-r--r--lib/eunit/src/eunit_tty.erl257
17 files changed, 4314 insertions, 0 deletions
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 <[email protected]>
+%% [http://www.process-one.net/]
+%% @author Richard Carlsson <[email protected]>
+%% [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 <a
+%% href="overview-summary.html#EUnit_test_representation">EUnit test
+%% representation</a> 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:
+%% <dl>
+%% <dt>`verbose'</dt>
+%% <dd>Displays more details about the running tests.</dd>
+%% </dl>
+%%
+%% 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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% [http://www.process-one.net/]
+%% @author Richard Carlsson <[email protected]>
+%% [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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% @author Eric Merritt <[email protected]>
+%% @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 <[email protected]>
+%% @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, [<<"<?xml version=\"1.0\" encoding=\"UTF-8\" ?>">>, ?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 = [
+ <<"<testsuite tests=\"">>, 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, [<<"</testsuite>">>, ?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, <<"<testcase time=\"">>, 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, <<"</testcase>">>, ?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, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
+format_testcase_result({failed, Term}) ->
+ [?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE,
+ escape_text(io_lib:write(Term)),
+ ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
+format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) ->
+ [?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE,
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
+format_testcase_result({aborted, Term}) ->
+ [?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE,
+ escape_text(io_lib:write(Term)),
+ ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
+format_testcase_result({skipped, {abort, Error}}) when is_tuple(Error) ->
+ [?INDENT, ?INDENT, <<"<skipped type=\"">>, escape_attr(atom_to_list(element(1, Error))), <<"\">">>, ?NEWLINE,
+ escape_text(eunit_lib:format_error(Error)),
+ ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE];
+format_testcase_result({skipped, {Type, Term}}) when is_atom(Type) ->
+ [?INDENT, ?INDENT, <<"<skipped type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
+ escape_text(io_lib:write(Term)),
+ ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE];
+format_testcase_result({skipped, timeout}) ->
+ [?INDENT, ?INDENT, <<"<skipped type=\"timeout\"/>">>, ?NEWLINE];
+format_testcase_result({skipped, Term}) ->
+ [?INDENT, ?INDENT, <<"<skipped type=\"unknown\">">>, ?NEWLINE,
+ escape_text(io_lib:write(Term)),
+ ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE].
+
+%% ----------------------------------------------------------------------------
+%% Format the output of a test case in xml.
+%% Empty output is simply the empty string.
+%% Other output is inside a <system-out> xml tag.
+%% ----------------------------------------------------------------------------
+format_testcase_output([]) -> [];
+format_testcase_output(Output) ->
+ [?INDENT, ?INDENT, <<"<system-out>">>, escape_text(Output), ?NEWLINE, ?INDENT, ?INDENT, <<"</system-out>">>, ?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 &lt;, > with &gt; and & with &amp;
+%% ----------------------------------------------------------------------------
+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 &lt;, > with &gt; and & with &amp;
+%% ----------------------------------------------------------------------------
+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 <[email protected]>
+%% @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 <[email protected]>
+%% @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 <[email protected]>
+%% @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");
+ <<Text:800/binary, _:1/binary, _/binary>> ->
+ 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).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-20 11:10:59 +0000