aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/test')
-rw-r--r--lib/diameter/test/Makefile408
-rw-r--r--lib/diameter/test/diameter.cover6
-rw-r--r--lib/diameter/test/diameter.spec9
-rw-r--r--lib/diameter/test/diameter_SUITE.erl108
-rw-r--r--lib/diameter/test/diameter_app_test.erl393
-rw-r--r--lib/diameter/test/diameter_appup_test.erl539
-rw-r--r--lib/diameter/test/diameter_compiler_test.erl104
-rw-r--r--lib/diameter/test/diameter_config_test.erl105
-rw-r--r--lib/diameter/test/diameter_etcp_test.beambin0 -> 1808 bytes
-rw-r--r--lib/diameter/test/diameter_peer_test.erl104
-rw-r--r--lib/diameter/test/diameter_reg_test.erl104
-rw-r--r--lib/diameter/test/diameter_session_test.erl104
-rw-r--r--lib/diameter/test/diameter_stats_test.erl104
-rw-r--r--lib/diameter/test/diameter_sync_test.erl104
-rw-r--r--lib/diameter/test/diameter_tcp_test.erl482
-rw-r--r--lib/diameter/test/diameter_test_lib.erl478
-rw-r--r--lib/diameter/test/diameter_test_lib.hrl106
-rw-r--r--lib/diameter/test/diameter_test_server.erl551
-rw-r--r--lib/diameter/test/modules.mk47
-rw-r--r--lib/diameter/test/slask/diameter_persistent_table_test.erl495
20 files changed, 4351 insertions, 0 deletions
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
new file mode 100644
index 0000000000..daae70b1e2
--- /dev/null
+++ b/lib/diameter/test/Makefile
@@ -0,0 +1,408 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2010. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+
+ifneq ($(ERL_TOP),)
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+else
+include $(DIAMETER_TOP)/make/target.mk
+include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk
+endif
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(DIAMETER_VSN)
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/diameter_test
+
+ifeq ($(findstring win32,$(TARGET)),win32)
+
+MAKEFILE_SRC = Makefile.win32.src
+
+else
+
+MAKEFILE_SRC = Makefile.src
+
+endif
+
+ifeq ($(TT_DIR),)
+TT_DIR = /tmp
+endif
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+include modules.mk
+
+EBIN = .
+
+HRL_FILES = diameter_test_lib.hrl
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+SOURCE = $(HRL_FILES) $(ERL_FILES)
+
+TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
+
+APP_CASES = app appup
+
+TRANSPORT_CASES = tcp
+
+ALL_CASES = \
+ $(APP_CASES) \
+ compiler conf sync session stats reg peer \
+ $(TRANSPORT_CASES)
+
+
+EMAKEFILE = Emakefile
+ifneq ($(ERL_TOP),)
+MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
+else
+MAKE_EMAKE = $(wildcard $(DIAMETER_TOP)/make/make_emakefile)
+endif
+
+ifeq ($(MAKE_EMAKE),)
+BUILDTARGET = $(TARGET_FILES)
+RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE)
+else
+BUILDTARGET = emakebuild
+RELTEST_FILES = $(EMAKEFILE) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE)
+endif
+
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../src/app/diameter.mk
+
+ifeq ($(USE_DIAMETER_TEST_CODE),true)
+ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom
+endif
+
+ifeq ($(USE_DIAMETER_HIPE),true)
+ERL_COMPILE_FLAGS += +native -DDIAMETER_hipe_special=true
+endif
+
+ifneq ($(ERL_TOP),)
+ERL_COMPILE_FLAGS += \
+ $(DIAMETER_ERL_COMPILE_FLAGS) \
+ -pa $(ERL_TOP)/lib/test_server/ebin \
+ -I$(ERL_TOP)/lib/test_server/include
+else
+ERL_COMPILE_FLAGS += \
+ $(DIAMETER_ERL_COMPILE_FLAGS) \
+ -pa $(TEST_SERVER_DIR)/ebin \
+ -I$(TEST_SERVER_DIR)/include
+endif
+
+ERL_PATH = \
+ -pa ../../$(APPLICATION)/ebin \
+ -pa ../../et/ebin
+
+ifndef SUITE
+SUITE = diameter_SUITE
+endif
+
+ESTOP = -s init stop
+
+ifeq ($(DONT_STOP),true)
+MAYBE_ESTOP =
+else
+MAYBE_ESTOP = $(ESTOP)
+endif
+
+ETVIEW = -s et_viewer
+ifeq ($(USE_ET_VIEWER),true)
+MAYBE_ETVIEW =
+else
+MAYBE_ETVIEW = $(ETVIEW)
+endif
+
+ifeq ($(MERL),)
+MERL = $(ERL)
+endif
+
+ARGS += -noshell
+
+ifeq ($(DISABLE_TC_TIMEOUT),true)
+ARGS += -diameter_test_timeout
+endif
+
+
+DIAMETER_TEST_SERVER = diameter_test_server
+
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+tests debug opt: $(BUILDTARGET)
+
+targets: $(TARGET_FILES)
+
+.PHONY: emakebuild
+
+emakebuild: $(EMAKEFILE)
+
+$(EMAKEFILE):
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' | grep -v Warning > $(EMAKEFILE)
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) | grep -v Warning >> $(EMAKEFILE)
+
+clean:
+ rm -f $(EMAKEFILE)
+ rm -f $(TARGET_FILES)
+ rm -f errs core *~
+
+docs:
+
+info:
+ @echo "MAKE_EMAKE = $(MAKE_EMAKE)"
+ @echo "EMAKEFILE = $(EMAKEFILE)"
+ @echo "BUILDTARGET = $(BUILDTARGET)"
+ @echo ""
+ @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
+ @echo "ERL = $(ERL)"
+ @echo "ERLC = $(ERLC)"
+ @echo "MERL = $(MERL)"
+ @echo ""
+ @echo "ARGS = $(ARGS)"
+ @echo ""
+ @echo "HRL_FILES = $(HRL_FILES)"
+ @echo "ERL_FILES = $(ERL_FILES)"
+ @echo "TARGET_FILES = $(TARGET_FILES)"
+ @echo ""
+
+help:
+ @echo ""
+ @echo "This Makefile controls the test of the $(APPLICATION) application. "
+ @echo ""
+ @echo "There are two separate ways to perform the test of $(APPLICATION)."
+ @echo ""
+ @echo " a) Run the official OTP test-server (which we do not describe here)"
+ @echo ""
+ @echo " b) Run the test-server provided with this application. "
+ @echo " There are a number of targets to run the entire or parts"
+ @echo " of this applications ($(APPLICATION)) test-suite"
+ @echo ""
+ @echo "Targets:"
+ @echo ""
+ @echo " help"
+ @echo " Print this info"
+ @echo ""
+ @echo " info"
+ @echo " Prints various environment variables. "
+ @echo " May be useful when debugging the Makefile. "
+ @echo ""
+ @echo " tests | debug | opt "
+ @echo " Compile all test-code. "
+ @echo ""
+ @echo " clean "
+ @echo " Remove all targets. "
+ @echo ""
+ @echo " test"
+ @echo " Run the entire $(APPLICATION) test-suite. "
+ @echo ""
+ @echo " app"
+ @echo " Run the $(APPLICATION) application sub-test-suite. "
+ @echo ""
+ @echo " appup"
+ @echo " Run the $(APPLICATION) application upgrade (appup) sub-test-suite. "
+ @echo ""
+ @echo " compiler"
+ @echo " Run the $(APPLICATION) compiler sub-test-suite(s). "
+ @echo ""
+ @echo " conf"
+ @echo " Run the $(APPLICATION) config sub-test-suite. "
+ @echo " Checks various aspects of the $(APPLICATION) configuration. "
+ @echo ""
+ @echo " sync"
+ @echo " Run the $(APPLICATION) sync sub-test-suite. "
+ @echo ""
+ @echo " session"
+ @echo " Run the $(APPLICATION) session sub-test-suite. "
+ @echo ""
+ @echo " stats"
+ @echo " Run the $(APPLICATION) stats sub-test-suite. "
+ @echo ""
+ @echo " reg"
+ @echo " Run the $(APPLICATION) reg sub-test-suite. "
+ @echo ""
+ @echo " peer"
+ @echo " Run the $(APPLICATION) peer sub-test-suite"
+ @echo ""
+ @echo " ptab"
+ @echo " Run the $(APPLICATION) persistent-table sub-test-suite"
+ @echo ""
+ @echo " tcp"
+ @echo " Run the $(APPLICATION) tcp sub-test-suite"
+ @echo ""
+ @echo ""
+
+
+# ----------------------------------------------------
+# Special Targets
+# ----------------------------------------------------
+
+all: make
+ @echo "make sure epmd is new"
+ @epmd -kill > /dev/null
+ @echo "Running all sub-suites separatelly"
+ @for i in $(ALL_CASES); do \
+ echo "SUITE: $$i"; \
+ clearmake -V $$i > $$i.log; \
+ done
+
+aall: make
+ @echo "make sure epmd is new"
+ @epmd -kill > /dev/null
+ @echo "Running all app sub-suites separatelly"
+ @for i in $(APP_CASES); do \
+ echo "SUITE: $$i"; \
+ clearmake -V $$i > $$i.log; \
+ done
+ echo "done"
+
+tall: make
+ @echo "make sure epmd is new"
+ @epmd -kill > /dev/null
+ @echo "Running all transport sub-suites separatelly"
+ @for i in $(TRANSPORT_CASES); do \
+ echo "SUITE: $$i"; \
+ clearmake -V $$i > $$i.log; \
+ done
+
+make: targets
+
+test: make
+ $(MERL) $(ARGS) -sname diameter_test $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
+ $(MAYBE_ESTOP)
+
+utest: make
+ $(MERL) $(ARGS) -sname diameter_utest $(ERL_PATH) \
+ $(MAYBE_ETVIEW) \
+ -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
+ $(ESTOP)
+
+# ftest: make
+# $(MERL) $(ARGS) -sname diameter_ftest $(ERL_PATH) \
+# -s diameter_filter \
+# -s $(DIAMETER_TEST_SERVER) t $(SUITE) \
+# $(ESTOP)
+#
+
+##########################
+
+# tickets: make
+# $(MERL) $(ARGS) -sname diameter_tickets $(ERL_PATH) \
+# -s $(DIAMETER_TEST_SERVER) tickets $(SUITE) \
+# $(ESTOP)
+#
+
+app: make
+ $(MERL) $(ARGS) -sname diameter_app $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_app_test \
+ $(ESTOP)
+
+appup: make
+ $(MERL) $(ARGS) -sname diameter_appup $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_appup_test \
+ $(ESTOP)
+
+compiler: make
+ $(MERL) $(ARGS) -sname diameter_compiler $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_compiler_test \
+ $(ESTOP)
+
+conf: make
+ $(MERL) $(ARGS) -sname diameter_config $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_config_test \
+ $(ESTOP)
+
+sync: make
+ $(MERL) $(ARGS) -sname diameter_sync $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_sync_test \
+ $(ESTOP)
+
+session: make
+ $(MERL) $(ARGS) -sname diameter_session $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_session_test \
+ $(ESTOP)
+
+stats: make
+ $(MERL) $(ARGS) -sname diameter_stats $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_stats_test \
+ $(ESTOP)
+
+reg: make
+ $(MERL) $(ARGS) -sname diameter_reg $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_reg_test \
+ $(ESTOP)
+
+peer: make
+ $(MERL) $(ARGS) -sname diameter_peer $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_peer_test \
+ $(ESTOP)
+
+ptab: make
+ $(MERL) $(ARGS) -sname diameter_persistent_table $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_persistent_table_test \
+ $(ESTOP)
+
+tcp: make
+ $(MERL) $(ARGS) -sname diameter_tcp $(ERL_PATH) \
+ -s $(DIAMETER_TEST_SERVER) t diameter_tcp_test \
+ $(ESTOP)
+
+
+node:
+ $(MERL) -sname diameter $(ERL_PATH)
+
+
+# ----------------------------------------------------
+# Release Targets
+# ----------------------------------------------------
+
+ifneq ($(ERL_TOP),)
+include $(ERL_TOP)/make/otp_release_targets.mk
+else
+include $(DIAMETER_TOP)/make/release_targets.mk
+endif
+
+release_spec:
+
+release_docs_spec:
+
+release_tests_spec: tests
+ $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR)
+# $(INSTALL_DATA) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) \
+# $(HRL_FILES) $(ERL_FILES) \
+# $(RELSYSDIR)
+#
+ chmod -f -R u+w $(RELSYSDIR)
+
diff --git a/lib/diameter/test/diameter.cover b/lib/diameter/test/diameter.cover
new file mode 100644
index 0000000000..5fde6c7d01
--- /dev/null
+++ b/lib/diameter/test/diameter.cover
@@ -0,0 +1,6 @@
+%% -*- erlang -*-
+{exclude,
+ [
+ ]
+}.
+
diff --git a/lib/diameter/test/diameter.spec b/lib/diameter/test/diameter.spec
new file mode 100644
index 0000000000..a6e71762eb
--- /dev/null
+++ b/lib/diameter/test/diameter.spec
@@ -0,0 +1,9 @@
+{suites, "../diameter_test", all}.
+%%{skip, {diameter_compiler_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_config_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_peer_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_reg_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_session_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_stats_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_sync_test, all, "Not yet implemented"}}.
+%%{skip, {diameter_tcp_test, all, "Not yet implemented"}}.
diff --git a/lib/diameter/test/diameter_SUITE.erl b/lib/diameter/test/diameter_SUITE.erl
new file mode 100644
index 0000000000..443cf90e92
--- /dev/null
+++ b/lib/diameter/test/diameter_SUITE.erl
@@ -0,0 +1,108 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Test application config
+%%----------------------------------------------------------------------
+
+-module(diameter_SUITE).
+
+-export([
+ suite/0,
+ all/0,
+ groups/0,
+
+ init_per_testcase/2,
+ fin_per_testcase/2,
+
+ init_per_suite/1,
+ end_per_suite/1,
+
+ init_per_group/2,
+ end_per_group/2,
+
+ init/0
+ ]).
+
+-export([t/0, t/1]).
+
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+init() ->
+ process_flag(trap_exit, true),
+ ?FLUSH().
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Top test case
+
+suite() ->
+ [{ct_hooks, [{ts_install_cth, [{nodenames,1}]}]}].
+
+all() ->
+ [
+ {group, app},
+ {group, appup},
+ {group, compiler},
+ {group, config},
+ {group, sync},
+ {group, session},
+ {group, stats},
+ {group, reg},
+ {group, peer},
+ {group, tcp}
+ ].
+
+groups() ->
+ [{app, [], [{diameter_app_test, all}]},
+ {appup, [], [{diameter_appup_test, all}]},
+ {compiler, [], [{diameter_compiler_test, all}]},
+ {config, [], [{diameter_config_test, all}]},
+ {sync, [], [{diameter_sync_test, all}]},
+ {session, [], [{diameter_session_test, all}]},
+ {stats, [], [{diameter_stats_test, all}]},
+ {reg, [], [{diameter_reg_test, all}]},
+ {peer, [], [{diameter_peer_test, all}]},
+ {tcp, [], [{diameter_tcp_test, all}]}].
+
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
diff --git a/lib/diameter/test/diameter_app_test.erl b/lib/diameter/test/diameter_app_test.erl
new file mode 100644
index 0000000000..7173c39caf
--- /dev/null
+++ b/lib/diameter/test/diameter_app_test.erl
@@ -0,0 +1,393 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the application specifics of the Diameter application
+%%----------------------------------------------------------------------
+-module(diameter_app_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2,
+
+ fields/1,
+ modules/1,
+ exportall/1,
+ app_depend/1,
+ undef_funcs/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(undef_funcs = Case, Config) ->
+ NewConfig = [{tc_timeout, ?MINUTES(10)} | Config],
+ diameter_test_server:init_per_testcase(Case, NewConfig);
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [
+ fields,
+ modules,
+ exportall,
+ app_depend,
+ undef_funcs
+ ].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ io:format("~w:init_per_suite -> entry with"
+ "~n Config: ~p"
+ "~n", [?MODULE, Config]),
+ case is_app(diameter) of
+ {ok, AppFile} ->
+ io:format("AppFile: ~n~p~n", [AppFile]),
+ %% diameter:print_version_info(),
+ [{app_file, AppFile}|Config];
+ {error, Reason} ->
+ ?FAIL(Reason)
+ end.
+
+is_app(App) ->
+ LibDir = code:lib_dir(App),
+ File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]),
+ case file:consult(File) of
+ {ok, [{application, App, AppFile}]} ->
+ {ok, AppFile};
+ Error ->
+ {error, {invalid_format, Error}}
+ end.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+fields(suite) ->
+ [];
+fields(doc) ->
+ [];
+fields(Config) when is_list(Config) ->
+ AppFile = ?KEY1SEARCH(app_file, Config),
+ Fields = [vsn, description, modules, registered, applications],
+ case check_fields(Fields, AppFile, []) of
+ [] ->
+ ok;
+ Missing ->
+ ?FAIL({missing_fields, Missing})
+ end.
+
+check_fields([], _AppFile, Missing) ->
+ Missing;
+check_fields([Field|Fields], AppFile, Missing) ->
+ check_fields(Fields, AppFile, check_field(Field, AppFile, Missing)).
+
+check_field(Name, AppFile, Missing) ->
+ io:format("checking field: ~p~n", [Name]),
+ case lists:keymember(Name, 1, AppFile) of
+ true ->
+ Missing;
+ false ->
+ [Name|Missing]
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+modules(suite) ->
+ [];
+modules(doc) ->
+ [];
+modules(Config) when is_list(Config) ->
+ AppFile = ?KEY1SEARCH(app_file, Config),
+ Mods = ?KEY1SEARCH(modules, AppFile),
+ EbinList = get_ebin_mods(diameter),
+ case missing_modules(Mods, EbinList, []) of
+ [] ->
+ ok;
+ Missing ->
+ throw({error, {missing_modules, Missing}})
+ end,
+ Allowed = [diameter_codegen,
+ diameter_make,
+ diameter_spec_scan,
+ diameter_spec_util],
+ case extra_modules(Mods, EbinList, Allowed, []) of
+ [] ->
+ ok;
+ Extra ->
+ throw({error, {extra_modules, Extra}})
+ end,
+ {ok, Mods}.
+
+get_ebin_mods(App) ->
+ LibDir = code:lib_dir(App),
+ EbinDir = filename:join([LibDir,"ebin"]),
+ {ok, Files0} = file:list_dir(EbinDir),
+ Files1 = [lists:reverse(File) || File <- Files0],
+ [list_to_atom(lists:reverse(Name)) || [$m,$a,$e,$b,$.|Name] <- Files1].
+
+
+missing_modules([], _Ebins, Missing) ->
+ Missing;
+missing_modules([Mod|Mods], Ebins, Missing) ->
+ case lists:member(Mod, Ebins) of
+ true ->
+ missing_modules(Mods, Ebins, Missing);
+ false ->
+ io:format("missing module: ~p~n", [Mod]),
+ missing_modules(Mods, Ebins, [Mod|Missing])
+ end.
+
+
+extra_modules(_Mods, [], Allowed, Extra) ->
+ Extra--Allowed;
+extra_modules(Mods, [Mod|Ebins], Allowed, Extra) ->
+ case lists:member(Mod, Mods) of
+ true ->
+ extra_modules(Mods, Ebins, Allowed, Extra);
+ false ->
+ io:format("supefluous module: ~p~n", [Mod]),
+ extra_modules(Mods, Ebins, Allowed, [Mod|Extra])
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+exportall(suite) ->
+ [];
+exportall(doc) ->
+ [];
+exportall(Config) when is_list(Config) ->
+ AppFile = ?KEY1SEARCH(app_file, Config),
+ Mods = ?KEY1SEARCH(modules, AppFile),
+ check_export_all(Mods).
+
+
+check_export_all([]) ->
+ ok;
+check_export_all([Mod|Mods]) ->
+ case (catch apply(Mod, module_info, [compile])) of
+ {'EXIT', {undef, _}} ->
+ check_export_all(Mods);
+ O ->
+ case lists:keysearch(options, 1, O) of
+ false ->
+ check_export_all(Mods);
+ {value, {options, List}} ->
+ case lists:member(export_all, List) of
+ true ->
+ throw({error, {export_all, Mod}});
+ false ->
+ check_export_all(Mods)
+ end
+ end
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+app_depend(suite) ->
+ [];
+app_depend(doc) ->
+ [];
+app_depend(Config) when is_list(Config) ->
+ AppFile = ?KEY1SEARCH(app_file, Config),
+ Apps = ?KEY1SEARCH(applications, AppFile),
+ check_apps(Apps).
+
+
+check_apps([]) ->
+ ok;
+check_apps([App|Apps]) ->
+ case is_app(App) of
+ {ok, _} ->
+ check_apps(Apps);
+ Error ->
+ throw({error, {missing_app, {App, Error}}})
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+undef_funcs(suite) ->
+ [];
+undef_funcs(doc) ->
+ [];
+undef_funcs(Config) when is_list(Config) ->
+ ?SKIP(diameter_not_known_by_xref),
+ App = diameter,
+ AppFile = ?KEY1SEARCH(app_file, Config),
+ Mods = ?KEY1SEARCH(modules, AppFile),
+ Root = code:root_dir(),
+ LibDir = code:lib_dir(App),
+ EbinDir = filename:join([LibDir,"ebin"]),
+ XRefTestName = undef_funcs_make_name(App, xref_test_name),
+ try
+ begin
+ XRef = xref_start(XRefTestName),
+ xref_set_defaults(XRef, [{verbose,false},{warnings,false}]),
+ XRefName = undef_funcs_make_name(App, xref_name),
+ XRefName = xref_add_release(XRef, Root, XRefName),
+ xref_replace_application(XRef, App, EbinDir),
+ Undefs = xref_analyze(XRef),
+ xref_stop(XRef),
+ analyze_undefined_function_calls(Undefs, Mods, [])
+ end
+ catch
+ throw:{error, Reason} ->
+ ?FAIL(Reason)
+ end.
+
+
+xref_start(XRefTestName) ->
+ case (catch xref:start(XRefTestName)) of
+ {ok, XRef} ->
+ XRef;
+ {error, Reason} ->
+ throw({error, {failed_starting_xref, Reason}});
+ Error ->
+ throw({error, {failed_starting_xref, Error}})
+ end.
+
+xref_set_defaults(XRef, Defs) ->
+ case (catch xref:set_default(XRef, Defs)) of
+ ok ->
+ ok;
+ Error ->
+ throw({error, {failed_setting_defaults, Defs, Error}})
+ end.
+
+xref_add_release(XRef, Root, Name) ->
+ case (catch xref:add_release(XRef, Root, {name, Name})) of
+ {ok, XRefName} ->
+ XRefName;
+ {error, Reason} ->
+ throw({error, {failed_adding_release, Reason}});
+ Error ->
+ throw({error, {failed_adding_release, Error}})
+ end.
+
+xref_replace_application(XRef, App, EbinDir) ->
+ case (catch xref:replace_application(XRef, App, EbinDir)) of
+ {ok, App} ->
+ ok;
+ {error, XRefMod, Reason} ->
+ throw({error, {failed_replacing_app, XRefMod, Reason}});
+ Error ->
+ throw({error, {failed_replacing_app, Error}})
+ end.
+
+xref_analyze(XRef) ->
+ case (catch xref:analyze(XRef, undefined_function_calls)) of
+ {ok, Undefs} ->
+ Undefs;
+ {error, Reason} ->
+ throw({error, {failed_detecting_func_calls, Reason}});
+ Error ->
+ throw({error, {failed_detecting_func_calls, Error}})
+ end.
+
+xref_stop(XRef) ->
+ xref:stop(XRef).
+
+analyze_undefined_function_calls([], _, []) ->
+ ok;
+analyze_undefined_function_calls([], _, AppUndefs) ->
+ exit({suite_failed, {undefined_function_calls, AppUndefs}});
+analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs],
+ AppModules, AppUndefs) ->
+ %% Check that this module is our's
+ case lists:member(Mod,AppModules) of
+ true ->
+ {Calling,Called} = AppUndef,
+ {Mod1,Func1,Ar1} = Calling,
+ {Mod2,Func2,Ar2} = Called,
+ io:format("undefined function call: "
+ "~n ~w:~w/~w calls ~w:~w/~w~n",
+ [Mod1,Func1,Ar1,Mod2,Func2,Ar2]),
+ analyze_undefined_function_calls(Undefs, AppModules,
+ [AppUndef|AppUndefs]);
+ false ->
+ io:format("dropping ~p~n", [Mod]),
+ analyze_undefined_function_calls(Undefs, AppModules, AppUndefs)
+ end.
+
+%% This function is used simply to avoid cut-and-paste errors later...
+undef_funcs_make_name(App, PostFix) ->
+ list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%% fail(Reason) ->
+%% exit({suite_failed, Reason}).
+
+%% ?KEY1SEARCH(Key, L) ->
+%% case lists:keysearch(Key, 1, L) of
+%% undefined ->
+%% fail({not_found, Key, L});
+%% {value, {Key, Value}} ->
+%% Value
+%% end.
diff --git a/lib/diameter/test/diameter_appup_test.erl b/lib/diameter/test/diameter_appup_test.erl
new file mode 100644
index 0000000000..97a089e01a
--- /dev/null
+++ b/lib/diameter/test/diameter_appup_test.erl
@@ -0,0 +1,539 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the application specifics of the Diameter application
+%%----------------------------------------------------------------------
+-module(diameter_appup_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2,
+
+ appup/1
+ ]).
+
+-export([t/0, t/1]).
+
+-compile({no_auto_import,[error/1]}).
+
+-include("diameter_test_lib.hrl").
+
+-define(APPLICATION, diameter).
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [appup].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ AppFile = file_name(?APPLICATION, ".app"),
+ AppupFile = file_name(?APPLICATION, ".appup"),
+ [{app_file, AppFile}, {appup_file, AppupFile}|Config].
+
+
+file_name(App, Ext) ->
+ LibDir = code:lib_dir(App),
+ filename:join([LibDir, "ebin", atom_to_list(App) ++ Ext]).
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+appup(suite) ->
+ [];
+appup(doc) ->
+ "perform a simple check of the appup file";
+appup(Config) when is_list(Config) ->
+ AppupFile = key1search(appup_file, Config),
+ AppFile = key1search(app_file, Config),
+ Modules = modules(AppFile),
+ check_appup(AppupFile, Modules).
+
+modules(File) ->
+ case file:consult(File) of
+ {ok, [{application,diameter,Info}]} ->
+ case lists:keysearch(modules,1,Info) of
+ {value, {modules, Modules}} ->
+ Modules;
+ false ->
+ fail({bad_appinfo, Info})
+ end;
+ Error ->
+ fail({bad_appfile, Error})
+ end.
+
+
+check_appup(AppupFile, Modules) ->
+ case file:consult(AppupFile) of
+ {ok, [{V, UpFrom, DownTo}]} ->
+ check_appup(V, UpFrom, DownTo, Modules);
+ Else ->
+ fail({bad_appupfile, Else})
+ end.
+
+
+check_appup(V, UpFrom, DownTo, Modules) ->
+ check_version(V),
+ check_depends(up, UpFrom, Modules),
+ check_depends(down, DownTo, Modules),
+ check_module_subset(UpFrom),
+ check_module_subset(DownTo),
+ ok.
+
+
+check_depends(_, [], _) ->
+ ok;
+check_depends(UpDown, [Dep|Deps], Modules) ->
+ check_depend(UpDown, Dep, Modules),
+ check_depends(UpDown, Deps, Modules).
+
+
+check_depend(up = UpDown, {add_application, ?APPLICATION} = Instr, Modules) ->
+ d("check_instructions(~w) -> entry with"
+ "~n Instruction: ~p"
+ "~n Modules: ~p", [UpDown, Instr, Modules]),
+ ok;
+check_depend(down = UpDown, {remove_application, ?APPLICATION} = Instr,
+ Modules) ->
+ d("check_instructions(~w) -> entry with"
+ "~n Instruction: ~p"
+ "~n Modules: ~p", [UpDown, Instr, Modules]),
+ ok;
+check_depend(UpDown, {V, Instructions}, Modules) ->
+ d("check_instructions(~w) -> entry with"
+ "~n V: ~p"
+ "~n Modules: ~p", [UpDown, V, Modules]),
+ check_version(V),
+ case check_instructions(UpDown,
+ Instructions, Instructions, [], [], Modules) of
+ {_Good, []} ->
+ ok;
+ {_, Bad} ->
+ fail({bad_instructions, Bad, UpDown})
+ end.
+
+
+check_instructions(_, [], _, Good, Bad, _) ->
+ {lists:reverse(Good), lists:reverse(Bad)};
+check_instructions(UpDown, [Instr|Instrs], AllInstr, Good, Bad, Modules) ->
+ d("check_instructions(~w) -> entry with"
+ "~n Instr: ~p", [UpDown,Instr]),
+ case (catch check_instruction(UpDown, Instr, AllInstr, Modules)) of
+ ok ->
+ check_instructions(UpDown, Instrs, AllInstr,
+ [Instr|Good], Bad, Modules);
+ {error, Reason} ->
+ d("check_instructions(~w) -> bad instruction: "
+ "~n Reason: ~p", [UpDown,Reason]),
+ check_instructions(UpDown, Instrs, AllInstr, Good,
+ [{Instr, Reason}|Bad], Modules)
+ end.
+
+%% A new module is added
+check_instruction(up, {add_module, Module}, _, Modules)
+ when is_atom(Module) ->
+ d("check_instruction -> entry when up-add_module instruction with"
+ "~n Module: ~p", [Module]),
+ check_module(Module, Modules);
+
+%% An old module is re-added
+check_instruction(down, {add_module, Module}, _, Modules)
+ when is_atom(Module) ->
+ d("check_instruction -> entry when down-add_module instruction with"
+ "~n Module: ~p", [Module]),
+ case (catch check_module(Module, Modules)) of
+ {error, {unknown_module, Module, Modules}} ->
+ ok;
+ ok ->
+ error({existing_readded_module, Module})
+ end;
+
+%% Removing a module on upgrade:
+%% - the module has been removed from the app-file.
+%% - check that no module depends on this (removed) module
+check_instruction(up, {remove, {Module, Pre, Post}}, _, Modules)
+ when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) ->
+ d("check_instruction -> entry when up-remove instruction with"
+ "~n Module: ~p"
+ "~n Pre: ~p"
+ "~n Post: ~p", [Module, Pre, Post]),
+ case (catch check_module(Module, Modules)) of
+ {error, {unknown_module, Module, Modules}} ->
+ check_purge(Pre),
+ check_purge(Post);
+ ok ->
+ error({existing_removed_module, Module})
+ end;
+
+%% Removing a module on downgrade: the module exist
+%% in the app-file.
+check_instruction(down, {remove, {Module, Pre, Post}}, AllInstr, Modules)
+ when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) ->
+ d("check_instruction -> entry when down-remove instruction with"
+ "~n Module: ~p"
+ "~n Pre: ~p"
+ "~n Post: ~p", [Module, Pre, Post]),
+ case (catch check_module(Module, Modules)) of
+ ok ->
+ check_purge(Pre),
+ check_purge(Post),
+ check_no_remove_depends(Module, AllInstr);
+ {error, {unknown_module, Module, Modules}} ->
+ error({nonexisting_removed_module, Module})
+ end;
+
+check_instruction(_, {load_module, Module, Pre, Post, Depend},
+ AllInstr, Modules)
+ when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) ->
+ d("check_instruction -> entry when load_module instruction with"
+ "~n Module: ~p"
+ "~n Pre: ~p"
+ "~n Post: ~p"
+ "~n Depend: ~p", [Module, Pre, Post, Depend]),
+ check_module(Module, Modules),
+ check_module_depend(Module, Depend, Modules),
+ check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
+ check_purge(Pre),
+ check_purge(Post);
+
+check_instruction(_, {update, Module, Change, Pre, Post, Depend},
+ AllInstr, Modules)
+ when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) ->
+ d("check_instruction -> entry when update instruction with"
+ "~n Module: ~p"
+ "~n Change: ~p"
+ "~n Pre: ~p"
+ "~n Post: ~p"
+ "~n Depend: ~p", [Module, Change, Pre, Post, Depend]),
+ check_module(Module, Modules),
+ check_module_depend(Module, Depend, Modules),
+ check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
+ check_change(Change),
+ check_purge(Pre),
+ check_purge(Post);
+
+check_instruction(_, {update, Module, supervisor}, _, Modules)
+ when is_atom(Module) ->
+ check_module(Module, Modules);
+
+check_instruction(_, {apply, {Module, Function, Args}}, _, Modules)
+ when is_atom(Module) andalso is_atom(Function) andalso is_list(Args) ->
+ d("check_instruction -> entry when down-apply instruction with"
+ "~n Module: ~p"
+ "~n Function: ~p"
+ "~n Args: ~p", [Module, Function, Args]),
+ check_module(Module, Modules),
+ check_apply(Module, Function, Args);
+
+check_instruction(_, {restart_application, ?APPLICATION}, _AllInstr, _Modules) ->
+ ok;
+
+check_instruction(_, Instr, _AllInstr, _Modules) ->
+ d("check_instruction -> entry when unknown instruction with"
+ "~n Instr: ~p", [Instr]),
+ error({error, {unknown_instruction, Instr}}).
+
+
+%% If Module X depends on Module Y, then module Y must have an update
+%% instruction of some sort (otherwise the depend is faulty).
+updated_modules([], Modules) ->
+ d("update_modules -> entry when done with"
+ "~n Modules: ~p", [Modules]),
+ Modules;
+updated_modules([Instr|Instrs], Modules) ->
+ d("update_modules -> entry with"
+ "~n Instr: ~p"
+ "~n Modules: ~p", [Instr,Modules]),
+ Module = instruction_module(Instr),
+ d("update_modules -> Module: ~p", [Module]),
+ updated_modules(Instrs, [Module|Modules]).
+
+instruction_module({add_module, Module}) ->
+ Module;
+instruction_module({remove, {Module, _, _}}) ->
+ Module;
+instruction_module({load_module, Module, _, _, _}) ->
+ Module;
+instruction_module({update, Module, _, _, _, _}) ->
+ Module;
+instruction_module({apply, {Module, _, _}}) ->
+ Module;
+instruction_module(Instr) ->
+ d("instruction_module -> entry when unknown instruction with"
+ "~n Instr: ~p", [Instr]),
+ error({error, {unknown_instruction, Instr}}).
+
+
+%% Check that the modules handled in an instruction set for version X
+%% is a subset of the instruction set for version X-1.
+check_module_subset(Instructions) ->
+ do_check_module_subset(modules_of(Instructions)).
+
+do_check_module_subset([]) ->
+ ok;
+do_check_module_subset([_]) ->
+ ok;
+do_check_module_subset([{_V1, Mods1}|T]) ->
+ {V2, Mods2} = hd(T),
+ %% Check that the modules in V1 is a subset of V2
+ case do_check_module_subset2(Mods1, Mods2) of
+ ok ->
+ do_check_module_subset(T);
+ {error, Modules} ->
+ fail({subset_missing_instructions, V2, Modules})
+ end.
+
+do_check_module_subset2(Mods1, Mods2) ->
+ do_check_module_subset2(Mods1, Mods2, []).
+
+do_check_module_subset2([], _, []) ->
+ ok;
+do_check_module_subset2([], _, Acc) ->
+ {error, lists:reverse(Acc)};
+do_check_module_subset2([Mod|Mods], Mods2, Acc) ->
+ case lists:member(Mod, Mods2) of
+ true ->
+ do_check_module_subset2(Mods, Mods2, Acc);
+ false ->
+ do_check_module_subset2(Mods, Mods2, [Mod|Acc])
+ end.
+
+
+modules_of(Instructions) ->
+ modules_of(Instructions, []).
+
+modules_of([], Acc) ->
+ lists:reverse(Acc);
+modules_of([{V,Instructions}|T], Acc) ->
+ Mods = modules_of2(Instructions, []),
+ modules_of(T, [{V, Mods}|Acc]).
+
+modules_of2([], Acc) ->
+ lists:reverse(Acc);
+modules_of2([Instr|Instructions], Acc) ->
+ case module_of(Instr) of
+ {value, Mod} ->
+ modules_of2(Instructions, [Mod|Acc]);
+ false ->
+ modules_of2(Instructions, Acc)
+ end.
+
+module_of({add_module, Module}) ->
+ {value, Module};
+module_of({remove, {Module, _Pre, _Post}}) ->
+ {value, Module};
+module_of({load_module, Module, _Pre, _Post, _Depend}) ->
+ {value, Module};
+module_of({update, Module, _Change, _Pre, _Post, _Depend}) ->
+ {value, Module};
+module_of(_) ->
+ false.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% The version is a string consting of numbers separated by dots: "."
+%% Example: "3.3.3"
+%%
+check_version(V) when is_list(V) ->
+ case do_check_version(string:tokens(V, [$.])) of
+ ok ->
+ ok;
+ {error, BadVersionPart} ->
+ throw({error, {bad_version, V, BadVersionPart}})
+ end;
+check_version(V) ->
+ error({bad_version, V}).
+
+do_check_version([]) ->
+ ok;
+do_check_version([H|T]) ->
+ case (catch list_to_integer(H)) of
+ I when is_integer(I) ->
+ do_check_version(T);
+ _ ->
+ {error, H}
+ end.
+
+check_module(M, Modules) when is_atom(M) ->
+ case lists:member(M,Modules) of
+ true ->
+ ok;
+ false ->
+ error({unknown_module, M, Modules})
+ end;
+check_module(M, _) ->
+ error({bad_module, M}).
+
+
+check_module_depend(M, [], _) when is_atom(M) ->
+ d("check_module_depend -> entry with"
+ "~n M: ~p", [M]),
+ ok;
+check_module_depend(M, Deps, Modules) when is_atom(M) andalso is_list(Deps) ->
+ d("check_module_depend -> entry with"
+ "~n M: ~p"
+ "~n Deps: ~p"
+ "~n Modules: ~p", [M, Deps, Modules]),
+ case [Dep || Dep <- Deps, lists:member(Dep, Modules) == false] of
+ [] ->
+ ok;
+ Unknown ->
+ error({unknown_depend_modules, Unknown})
+ end;
+check_module_depend(_M, D, _Modules) ->
+ d("check_module_depend -> entry when bad depend with"
+ "~n D: ~p", [D]),
+ error({bad_depend, D}).
+
+
+check_no_remove_depends(_Module, []) ->
+ ok;
+check_no_remove_depends(Module, [Instr|Instrs]) ->
+ check_no_remove_depend(Module, Instr),
+ check_no_remove_depends(Module, Instrs).
+
+check_no_remove_depend(Module, {load_module, Mod, _Pre, _Post, Depend}) ->
+ case lists:member(Module, Depend) of
+ true ->
+ error({removed_module_in_depend, load_module, Mod, Module});
+ false ->
+ ok
+ end;
+check_no_remove_depend(Module, {update, Mod, _Change, _Pre, _Post, Depend}) ->
+ case lists:member(Module, Depend) of
+ true ->
+ error({removed_module_in_depend, update, Mod, Module});
+ false ->
+ ok
+ end;
+check_no_remove_depend(_, _) ->
+ ok.
+
+
+check_change(soft) ->
+ ok;
+check_change({advanced, _Something}) ->
+ ok;
+check_change(Change) ->
+ error({bad_change, Change}).
+
+
+check_purge(soft_purge) ->
+ ok;
+check_purge(brutal_purge) ->
+ ok;
+check_purge(Purge) ->
+ error({bad_purge, Purge}).
+
+
+check_apply(Module, Function, Args) ->
+ case (catch Module:module_info()) of
+ Info when is_list(Info) ->
+ check_exported(Function, Args, Info);
+ {'EXIT', {undef, _}} ->
+ error({not_existing_module, Module})
+ end.
+
+check_exported(Function, Args, Info) ->
+ case lists:keysearch(exports, 1, Info) of
+ {value, {exports, FuncList}} ->
+ Arity = length(Args),
+ Arities = [A || {F, A} <- FuncList, F == Function],
+ case lists:member(Arity, Arities) of
+ true ->
+ ok;
+ false ->
+ error({not_exported_function, Function, Arity})
+ end;
+ _ ->
+ error({bad_export, Info})
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+error(Reason) ->
+ throw({error, Reason}).
+
+fail(Reason) ->
+ exit({suite_failed, Reason}).
+
+key1search(Key, L) ->
+ case lists:keysearch(Key, 1, L) of
+ undefined ->
+ fail({not_found, Key, L});
+ {value, {Key, Value}} ->
+ Value
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+d(F, A) ->
+ d(false, F, A).
+
+d(true, F, A) ->
+ io:format(F ++ "~n", A);
+d(_, _, _) ->
+ ok.
+
+
diff --git a/lib/diameter/test/diameter_compiler_test.erl b/lib/diameter/test/diameter_compiler_test.erl
new file mode 100644
index 0000000000..ae4c9c668d
--- /dev/null
+++ b/lib/diameter/test/diameter_compiler_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the dia compiler of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_compiler_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_config_test.erl b/lib/diameter/test/diameter_config_test.erl
new file mode 100644
index 0000000000..c44fb654ab
--- /dev/null
+++ b/lib/diameter/test/diameter_config_test.erl
@@ -0,0 +1,105 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the config server of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_config_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_etcp_test.beam b/lib/diameter/test/diameter_etcp_test.beam
new file mode 100644
index 0000000000..efaaec69d5
--- /dev/null
+++ b/lib/diameter/test/diameter_etcp_test.beam
Binary files differ
diff --git a/lib/diameter/test/diameter_peer_test.erl b/lib/diameter/test/diameter_peer_test.erl
new file mode 100644
index 0000000000..27e75e26ef
--- /dev/null
+++ b/lib/diameter/test/diameter_peer_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the peer component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_peer_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_reg_test.erl b/lib/diameter/test/diameter_reg_test.erl
new file mode 100644
index 0000000000..0469b833cb
--- /dev/null
+++ b/lib/diameter/test/diameter_reg_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010_2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the reg component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_reg_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_session_test.erl b/lib/diameter/test/diameter_session_test.erl
new file mode 100644
index 0000000000..a32647d83d
--- /dev/null
+++ b/lib/diameter/test/diameter_session_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the session component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_session_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_stats_test.erl b/lib/diameter/test/diameter_stats_test.erl
new file mode 100644
index 0000000000..8b666edf50
--- /dev/null
+++ b/lib/diameter/test/diameter_stats_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the stats component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_stats_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_sync_test.erl b/lib/diameter/test/diameter_sync_test.erl
new file mode 100644
index 0000000000..618fa5021b
--- /dev/null
+++ b/lib/diameter/test/diameter_sync_test.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the sync component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_sync_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2
+
+ %% foo/1
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case example
+%%
+
+%% foo(suite) ->
+%% [];
+%% foo(doc) ->
+%% [];
+%% foo(Config) when is_list(Config) ->
+%% ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
diff --git a/lib/diameter/test/diameter_tcp_test.erl b/lib/diameter/test/diameter_tcp_test.erl
new file mode 100644
index 0000000000..01b5dc5293
--- /dev/null
+++ b/lib/diameter/test/diameter_tcp_test.erl
@@ -0,0 +1,482 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the tcp transport component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_tcp_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ suite_init/1, suite_fin/1,
+ init_per_group/2, end_per_group/2,
+
+ start_and_stop_transport_plain/1,
+ start_and_listen/1,
+ simple_connect/1,
+ simple_send_and_recv/1
+
+ ]).
+
+-export([t/0, t/1]).
+
+%% diameter_peer (internal) callback API
+-export([up/1, up/3, recv/2]).
+
+-include("diameter_test_lib.hrl").
+-include_lib("diameter/include/diameter.hrl").
+%% -include_lib("diameter/src/tcp/diameter_tcp.hrl").
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all() ->
+ [
+ {group, start},
+ {group, simple}
+ ].
+
+groups() ->
+ [
+ {start, [], [start_and_stop_transport_plain, start_and_listen]},
+ {simple, [], [simple_connect, simple_send_and_recv]}
+ ].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(X) -> init_per_suite(X).
+
+init_per_suite(suite) -> [];
+init_per_suite(doc) -> [];
+init_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(X) -> end_per_suite(X).
+
+end_per_suite(suite) -> [];
+end_per_suite(doc) -> [];
+end_per_suite(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case(s)
+%%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Plain start and stop of TCP transport
+%%
+
+start_and_stop_transport_plain(suite) ->
+ [];
+start_and_stop_transport_plain(doc) ->
+ [];
+start_and_stop_transport_plain(Config) when is_list(Config) ->
+
+ ?SKIP(not_yet_implemented),
+
+ %% This has been changed *a lot* since it was written...
+
+ process_flag(trap_exit, true),
+ Transport = ensure_transport_started(),
+ TcpTransport = ensure_tcp_transport_started(),
+ ensure_tcp_transport_stopped(TcpTransport),
+ ensure_transport_stopped(Transport),
+ i("done"),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Start TCP transport and then create a listen socket
+%%
+
+start_and_listen(suite) ->
+ [];
+start_and_listen(doc) ->
+ [];
+start_and_listen(Config) when is_list(Config) ->
+
+ ?SKIP(not_yet_implemented),
+
+ %% This has been changed *a lot* since it was written...
+
+ process_flag(trap_exit, true),
+ Transport = ensure_transport_started(),
+ TcpTransport = ensure_tcp_transport_started(),
+
+ case listen([{port, 0}]) of
+ {ok, Acceptor} when is_pid(Acceptor) ->
+ Ref = erlang:monitor(process, Acceptor),
+ [{Acceptor, Info}] = diameter_tcp:which_listeners(),
+ case lists:keysearch(socket, 1, Info) of
+ {value, {_, Listen}} ->
+ i("Listen socket: ~p"
+ "~n Opts: ~p"
+ "~n Stats: ~p"
+ "~n Name: ~p",
+ [Listen,
+ ok(inet:getopts(Listen, [keepalive, delay_send])),
+ ok(inet:getstat(Listen)),
+ ok(inet:sockname(Listen))
+ ]),
+ ok;
+ _ ->
+ ?FAIL({bad_listener_info, Acceptor, Info})
+ end,
+ Crash = simulate_crash,
+ exit(Acceptor, Crash),
+ receive
+ {'DOWN', Ref, process, Acceptor, Crash} ->
+ ?SLEEP(1000),
+ case diameter_tcp:which_listeners() of
+ [{NewAcceptor, _NewInfo}] ->
+ diameter_tcp_accept:stop(NewAcceptor),
+ ?SLEEP(1000),
+ case diameter_tcp:which_listeners() of
+ [] ->
+ ok;
+ UnexpectedListeners ->
+ ?FAIL({unexpected_listeners, empty, UnexpectedListeners})
+ end;
+ UnexpectedListeners ->
+ ?FAIL({unexpected_listeners, non_empty, UnexpectedListeners})
+ end
+ after 5000 ->
+ ?FAIL({failed_killing, Acceptor})
+ end;
+ Error ->
+ ?FAIL({failed_creating_acceptor, Error})
+ end,
+ ensure_tcp_transport_stopped(TcpTransport),
+ ensure_transport_stopped(Transport),
+ i("done"),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% TCP transport connecting
+%%
+
+simple_connect(suite) ->
+ [];
+simple_connect(doc) ->
+ [];
+simple_connect(Config) when is_list(Config) ->
+
+ ?SKIP(not_yet_implemented),
+
+ %% This has been changed *a lot* since it was written...
+
+ process_flag(trap_exit, true),
+ Transport = ensure_transport_started(),
+ TcpTransport = ensure_tcp_transport_started(),
+ {_Acceptor, Port} = ensure_tcp_listener(),
+
+ {ok, Hostname} = inet:gethostname(),
+
+ i("try connect"),
+ Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}],
+ Conn = case connect(Opts) of
+ {ok, C} ->
+ C;
+ Error ->
+ ?FAIL({failed_connecting, Error})
+ end,
+ i("connected: ~p", [Conn]),
+
+ %% Up for connect
+ receive
+ {diameter, {up, Host, Port}} ->
+ i("Received expected connect up (~p:~p)", [Host, Port]),
+ ok
+ after 5000 ->
+ ?FAIL(connect_up_confirmation_timeout)
+ end,
+
+ %% Up for accept
+ receive
+ {diameter, {up, _ConnPid}} ->
+ i("Received expected accept up"),
+ ok
+ after 5000 ->
+ ?FAIL(acceptor_up_confirmation_timeout)
+ end,
+
+ i("try disconnect"),
+ diameter_tcp:disconnect(Conn),
+ ensure_tcp_transport_stopped(TcpTransport),
+ ensure_transport_stopped(Transport),
+ i("done"),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Plain start and stop of TCP transport
+%%
+
+simple_send_and_recv(suite) ->
+ [];
+simple_send_and_recv(doc) ->
+ [];
+simple_send_and_recv(Config) when is_list(Config) ->
+
+ ?SKIP(not_yet_implemented),
+
+ %% This has been changed *a lot* since it was written...
+
+ process_flag(trap_exit, true),
+ %% --------------------------------------------------
+ %% Start the TCP transport sub-system
+ %%
+
+ Transport = ensure_transport_started(),
+ TcpTransport = ensure_tcp_transport_started(),
+
+ {_Acceptor, Port} = ensure_tcp_listener(),
+
+ {ok, Hostname} = inet:gethostname(),
+
+ i("try connect"),
+ Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}],
+ Conn = case connect(Opts) of
+ {ok, C1} ->
+ C1;
+ Error ->
+ ?FAIL({failed_connecting, Error})
+ end,
+ i("connected: ~p", [Conn]),
+
+ %% Up for connect
+ receive
+ {diameter, {up, Host, Port}} ->
+ i("Received expected connect up (~p:~p)", [Host, Port]),
+ ok
+ after 5000 ->
+ ?FAIL(connect_up_confirmation_timeout)
+ end,
+
+ %% Up for accept
+ APid =
+ receive
+ {diameter, {up, C2}} ->
+ i("Received expected accept up"),
+ C2
+ after 5000 ->
+ ?FAIL(acceptor_up_confirmation_timeout)
+ end,
+
+ %% --------------------------------------------------
+ %% Start some stuff needed for the codec to run
+ %%
+
+ i("start persistent table"),
+ {ok, _Pers} = diameter_persistent_table:start_link(),
+
+ i("start session"),
+ {ok, _Session} = diameter_session:start_link(),
+
+ i("try decode a (DWR) message"),
+ Base = diameter_gen_base_rfc3588,
+ DWR = ['DWR',
+ {'Origin-Host', Hostname},
+ {'Origin-Realm', "whatever-realm"},
+ {'Origin-State-Id', [10]}],
+
+ #diameter_packet{msg = Msg} = diameter_codec:encode(Base, DWR),
+
+
+ %% --------------------------------------------------
+ %% Now try to send the message
+ %%
+ %% This is not the codec-test suite, so we dont really care what we
+ %% send, as long as it encoded/decodes correctly in the transport
+ %%
+
+ i("try send from connect side"),
+ ok = diameter_tcp:send_message(Conn, Msg),
+
+ %% Wait for data on Accept side
+ APkt =
+ receive
+ {diameter, {recv, A}} ->
+ i("[accept] Received expected data message: ~p", [A]),
+ A
+ after 5000 ->
+ ?FAIL(acceptor_up_confirmation_timeout)
+ end,
+
+ %% Send the same message back, just to have something to send...
+ i("try send (\"reply\") from accept side"),
+ ok = diameter_tcp:send_message(APid, APkt),
+
+ %% Wait for data on Connect side
+ receive
+ {diameter, {recv, B}} ->
+ i("[connect] Received expected data message: ~p", [B]),
+ ok
+ after 5000 ->
+ ?FAIL(acceptor_up_confirmation_timeout)
+ end,
+
+ i("we are done - now close shop"),
+ diameter_session:stop(),
+ diameter_persistent_table:stop(),
+
+ ensure_tcp_transport_stopped(TcpTransport),
+ ensure_transport_stopped(Transport),
+ i("done"),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ensure_transport_started() ->
+%% i("start diameter transport (top) supervisor"),
+ case diameter_transport_sup:start_link() of
+ {ok, TransportSup} ->
+ TransportSup;
+ Error ->
+ ?FAIL({failed_starting_transport_sup, Error})
+ end.
+
+ensure_transport_stopped(Pid) when is_pid(Pid) ->
+%% i("stop diameter transport (top) supervisor"),
+ Stop = fun(P) -> exit(P, kill) end,
+ ensure_stopped(Pid, Stop, failed_stopping_transport_sup).
+
+ensure_tcp_transport_started() ->
+%% i("start diameter TCP transport"),
+ case diameter_tcp:start_transport() of
+ {ok, TcpTransport} when is_pid(TcpTransport) ->
+ TcpTransport;
+ Error ->
+ ?FAIL({failed_starting_transport, Error})
+ end.
+
+ensure_tcp_transport_stopped(Pid) when is_pid(Pid) ->
+%% i("stop diameter TCP transport supervisor"),
+ Stop = fun(P) -> diameter_tcp:stop_transport(P) end,
+ ensure_stopped(Pid, Stop, failed_stopping_tcp_transport).
+
+
+ensure_tcp_listener() ->
+%% i("create diameter TCP transport listen socket"),
+ case listen([{port, 0}]) of
+ {ok, Acceptor} ->
+ [{Acceptor, Info}] = diameter_tcp:which_listeners(),
+ case lists:keysearch(socket, 1, Info) of
+ {value, {_, Listen}} ->
+ {ok, Port} = inet:port(Listen),
+ {Acceptor, Port};
+ _ ->
+ ?FAIL({failed_retrieving_listen_socket, Info})
+ end;
+ Error ->
+ ?FAIL({failed_creating_listen_socket, Error})
+ end.
+
+
+ensure_stopped(Pid, Stop, ReasonTag) when is_pid(Pid) ->
+%% i("ensure_stopped -> create monitor to ~p", [Pid]),
+ Ref = erlang:monitor(process, Pid),
+%% i("ensure_stopped -> try stop"),
+ Stop(Pid),
+%% i("ensure_stopped -> await DOWN message"),
+ receive
+ {'DOWN', Ref, process, Pid, _} ->
+%% i("ensure_stopped -> received DOWN message"),
+ ok
+ after 5000 ->
+%% i("ensure_stopped -> timeout"),
+ ?FAIL({ReasonTag, Pid})
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+listen(Opts) ->
+ diameter_tcp:listen([{module, ?MODULE} | Opts]).
+
+connect(Opts) ->
+ diameter_tcp:connect([{module, ?MODULE} | Opts]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+up(Pid, Host, Port) ->
+ Pid ! {diameter, {up, Host, Port}},
+ ok.
+
+up(Pid) ->
+ Pid ! {diameter, {up, self()}},
+ ok.
+
+recv(Pid, Pkt) ->
+ Pid ! {diameter, {recv, Pkt}}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+i(F) ->
+ i(F, []).
+
+i(F, A) ->
+ io:format(F ++ "~n", A).
+
+
+ok({ok, Whatever}) ->
+ Whatever;
+ok(Crap) ->
+ Crap.
+
+
diff --git a/lib/diameter/test/diameter_test_lib.erl b/lib/diameter/test/diameter_test_lib.erl
new file mode 100644
index 0000000000..16b3b9d216
--- /dev/null
+++ b/lib/diameter/test/diameter_test_lib.erl
@@ -0,0 +1,478 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Lightweight test server
+%%----------------------------------------------------------------------
+%%
+
+-module(diameter_test_lib).
+
+-export([
+ sleep/1,
+
+ hours/1,
+ minutes/1,
+ seconds/1,
+
+ key1search/2,
+
+ non_pc_tc_maybe_skip/4,
+ os_based_skip/1,
+
+ fail/3,
+ skip/3,
+ fatal_skip/3,
+
+ log/4,
+ error/3,
+
+ flush/0,
+
+ proxy_start/1, proxy_start/2,
+ proxy_init/2,
+
+ still_alive/1,
+
+ prepare_test_case/5,
+ lookup_config/2,
+
+ mk_nodes/2, start_nodes/3,
+
+ display_system_info/1, display_system_info/2, display_system_info/3,
+ display_alloc_info/0,
+ alloc_info/0,
+
+ report_event/3
+
+ ]).
+
+-include("diameter_test_lib.hrl").
+
+-record('REASON', {mod, line, desc}).
+
+
+%% ----------------------------------------------------------------
+%% Time related function
+%%
+
+sleep(infinity) ->
+ receive
+ after infinity ->
+ ok
+ end;
+sleep(MSecs) ->
+ receive
+ after trunc(MSecs) ->
+ ok
+ end,
+ ok.
+
+
+hours(N) -> trunc(N * 1000 * 60 * 60).
+minutes(N) -> trunc(N * 1000 * 60).
+seconds(N) -> trunc(N * 1000).
+
+
+%% ----------------------------------------------------------------
+
+key1search(Key, L) ->
+ case lists:keysearch(Key, 1, L) of
+ undefined ->
+ fail({not_found, Key, L}, ?MODULE, ?LINE);
+ {value, {Key, Value}} ->
+ Value
+ end.
+
+
+%% ----------------------------------------------------------------
+%% Conditional skip of testcases
+%%
+
+non_pc_tc_maybe_skip(Config, Condition, File, Line)
+ when is_list(Config) andalso is_function(Condition) ->
+ %% Check if we shall skip the skip
+ case os:getenv("TS_OS_BASED_SKIP") of
+ "false" ->
+ ok;
+ _ ->
+ case lists:keysearch(ts, 1, Config) of
+ {value, {ts, megaco}} ->
+ %% Always run the testcase if we are using our own
+ %% test-server...
+ ok;
+ _ ->
+ case (catch Condition()) of
+ true ->
+ skip(non_pc_testcase, File, Line);
+ _ ->
+ ok
+ end
+ end
+ end.
+
+
+os_based_skip(any) ->
+ true;
+os_based_skip(Skippable) when is_list(Skippable) ->
+ {OsFam, OsName} =
+ case os:type() of
+ {_Fam, _Name} = FamAndName ->
+ FamAndName;
+ Fam ->
+ {Fam, undefined}
+ end,
+ case lists:member(OsFam, Skippable) of
+ true ->
+ true;
+ false ->
+ case lists:keysearch(OsFam, 1, Skippable) of
+ {value, {OsFam, OsName}} ->
+ true;
+ {value, {OsFam, OsNames}} when is_list(OsNames) ->
+ lists:member(OsName, OsNames);
+ _ ->
+ false
+ end
+ end;
+os_based_skip(_) ->
+ false.
+
+
+%%----------------------------------------------------------------------
+
+error(Actual, Mod, Line) ->
+ global:send(megaco_global_logger, {failed, Mod, Line}),
+ log("<ERROR> Bad result: ~p~n", [Actual], Mod, Line),
+ Label = lists:concat([Mod, "(", Line, ") unexpected result"]),
+ report_event(60, Label, [{line, Mod, Line}, {error, Actual}]),
+ case global:whereis_name(megaco_test_case_sup) of
+ undefined ->
+ ignore;
+ Pid ->
+ Fail = #'REASON'{mod = Mod, line = Line, desc = Actual},
+ Pid ! {fail, self(), Fail}
+ end,
+ Actual.
+
+log(Format, Args, Mod, Line) ->
+ case global:whereis_name(megaco_global_logger) of
+ undefined ->
+ io:format(user, "~p~p(~p): " ++ Format,
+ [self(), Mod, Line] ++ Args);
+ Pid ->
+ io:format(Pid, "~p~p(~p): " ++ Format,
+ [self(), Mod, Line] ++ Args)
+ end.
+
+skip(Actual, File, Line) ->
+ log("Skipping test case~n", [], File, Line),
+ String = lists:flatten(io_lib:format("Skipping test case ~p(~p): ~p~n",
+ [File, Line, Actual])),
+ exit({skipped, String}).
+
+fatal_skip(Actual, File, Line) ->
+ error(Actual, File, Line),
+ exit(shutdown).
+
+
+fail(Actual, File, Line) ->
+ log("Test case failing~n", [], File, Line),
+ String = lists:flatten(io_lib:format("Test case failing ~p (~p): ~p~n",
+ [File, Line, Actual])),
+ exit({suite_failed, String}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Flush the message queue and return its messages
+
+flush() ->
+ receive
+ Msg ->
+ [Msg | flush()]
+ after 1000 ->
+ []
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The proxy process
+
+proxy_start(ProxyId) ->
+ spawn_link(?MODULE, proxy_init, [ProxyId, self()]).
+
+proxy_start(Node, ProxyId) ->
+ spawn_link(Node, ?MODULE, proxy_init, [ProxyId, self()]).
+
+proxy_init(ProxyId, Controller) ->
+ process_flag(trap_exit, true),
+ ?LOG("[~p] proxy started by ~p~n",[ProxyId, Controller]),
+ proxy_loop(ProxyId, Controller).
+
+proxy_loop(OwnId, Controller) ->
+ receive
+ {'EXIT', Controller, Reason} ->
+ p("proxy_loop -> received exit from controller"
+ "~n Reason: ~p"
+ "~n", [Reason]),
+ exit(Reason);
+ {apply, Fun} ->
+ p("proxy_loop -> received apply request~n", []),
+ Res = Fun(),
+ p("proxy_loop -> apply result: "
+ "~n ~p"
+ "~n", [Res]),
+ Controller ! {res, OwnId, Res},
+ proxy_loop(OwnId, Controller);
+ OtherMsg ->
+ p("proxy_loop -> received unknown message: "
+ "~n OtherMsg: ~p"
+ "~n", [OtherMsg]),
+ Controller ! {msg, OwnId, OtherMsg},
+ proxy_loop(OwnId, Controller)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Check if process is alive and kicking
+still_alive(Pid) ->
+ case catch erlang:is_process_alive(Pid) of % New BIF in Erlang/OTP R5
+ true ->
+ true;
+ false ->
+ false;
+ {'EXIT', _} -> % Pre R5 backward compatibility
+ case process_info(Pid, message_queue_len) of
+ undefined -> false;
+ _ -> true
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+mk_nodes(0, Nodes) ->
+ Nodes;
+mk_nodes(N, []) ->
+ mk_nodes(N - 1, [node()]);
+mk_nodes(N, Nodes) when N > 0 ->
+ Head = hd(Nodes),
+ [Name, Host] = node_to_name_and_host(Head),
+ Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)].
+
+mk_node(N, Name, Host) ->
+ list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])).
+
+%% Returns [Name, Host]
+node_to_name_and_host(Node) ->
+ string:tokens(atom_to_list(Node), [$@]).
+
+start_nodes([Node | Nodes], File, Line) ->
+ case net_adm:ping(Node) of
+ pong ->
+ start_nodes(Nodes, File, Line);
+ pang ->
+ [Name, Host] = node_to_name_and_host(Node),
+ case slave:start_link(Host, Name) of
+ {ok, NewNode} when NewNode =:= Node ->
+ Path = code:get_path(),
+ {ok, Cwd} = file:get_cwd(),
+ true = rpc:call(Node, code, set_path, [Path]),
+ ok = rpc:call(Node, file, set_cwd, [Cwd]),
+ true = rpc:call(Node, code, set_path, [Path]),
+ {_, []} = rpc:multicall(global, sync, []),
+ start_nodes(Nodes, File, Line);
+ Other ->
+ fatal_skip({cannot_start_node, Node, Other}, File, Line)
+ end
+ end;
+start_nodes([], _File, _Line) ->
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+display_alloc_info() ->
+ io:format("Allocator memory information:~n", []),
+ AllocInfo = alloc_info(),
+ display_alloc_info(AllocInfo).
+
+display_alloc_info([]) ->
+ ok;
+display_alloc_info([{Alloc, Mem}|AllocInfo]) ->
+ io:format(" ~15w: ~10w~n", [Alloc, Mem]),
+ display_alloc_info(AllocInfo).
+
+alloc_info() ->
+ case erlang:system_info(allocator) of
+ {_Allocator, _Version, Features, _Settings} ->
+ alloc_info(Features);
+ _ ->
+ []
+ end.
+
+alloc_info(Allocators) ->
+ Allocs = [temp_alloc, sl_alloc, std_alloc, ll_alloc, eheap_alloc,
+ ets_alloc, binary_alloc, driver_alloc],
+ alloc_info(Allocators, Allocs, []).
+
+alloc_info([], _, Acc) ->
+ lists:reverse(Acc);
+alloc_info([Allocator | Allocators], Allocs, Acc) ->
+ case lists:member(Allocator, Allocs) of
+ true ->
+ Instances0 = erlang:system_info({allocator, Allocator}),
+ Instances =
+ if
+ is_list(Instances0) ->
+ [Instance || Instance <- Instances0,
+ element(1, Instance) =:= instance];
+ true ->
+ []
+ end,
+ AllocatorMem = alloc_mem_info(Instances),
+ alloc_info(Allocators, Allocs, [{Allocator, AllocatorMem} | Acc]);
+
+ false ->
+ alloc_info(Allocators, Allocs, Acc)
+ end.
+
+alloc_mem_info(Instances) ->
+ alloc_mem_info(Instances, []).
+
+alloc_mem_info([], Acc) ->
+ lists:sum([Mem || {instance, _, Mem} <- Acc]);
+alloc_mem_info([{instance, N, Info}|Instances], Acc) ->
+ InstanceMemInfo = alloc_instance_mem_info(Info),
+ alloc_mem_info(Instances, [{instance, N, InstanceMemInfo} | Acc]).
+
+alloc_instance_mem_info(InstanceInfo) ->
+ MBCS = alloc_instance_mem_info(mbcs, InstanceInfo),
+ SBCS = alloc_instance_mem_info(sbcs, InstanceInfo),
+ MBCS + SBCS.
+
+alloc_instance_mem_info(Key, InstanceInfo) ->
+ case lists:keysearch(Key, 1, InstanceInfo) of
+ {value, {Key, Info}} ->
+ case lists:keysearch(blocks_size, 1, Info) of
+ {value, {blocks_size, Mem, _, _}} ->
+ Mem;
+ _ ->
+ 0
+ end;
+ _ ->
+ 0
+ end.
+
+
+display_system_info(WhenStr) ->
+ display_system_info(WhenStr, undefined, undefined).
+
+display_system_info(WhenStr, undefined, undefined) ->
+ display_system_info(WhenStr, "");
+display_system_info(WhenStr, Mod, Func) ->
+ ModFuncStr = lists:flatten(io_lib:format(" ~w:~w", [Mod, Func])),
+ display_system_info(WhenStr, ModFuncStr).
+
+display_system_info(WhenStr, ModFuncStr) ->
+ Fun = fun(F) -> case (catch F()) of
+ {'EXIT', _} ->
+ undefined;
+ Res ->
+ Res
+ end
+ end,
+ ProcCount = Fun(fun() -> erlang:system_info(process_count) end),
+ ProcLimit = Fun(fun() -> erlang:system_info(process_limit) end),
+ ProcMemAlloc = Fun(fun() -> erlang:memory(processes) end),
+ ProcMemUsed = Fun(fun() -> erlang:memory(processes_used) end),
+ ProcMemBin = Fun(fun() -> erlang:memory(binary) end),
+ ProcMemTot = Fun(fun() -> erlang:memory(total) end),
+ %% error_logger:info_msg(
+ io:format("~n"
+ "~n*********************************************"
+ "~n"
+ "System info ~s~s => "
+ "~n Process count: ~w"
+ "~n Process limit: ~w"
+ "~n Process memory alloc: ~w"
+ "~n Process memory used: ~w"
+ "~n Memory for binaries: ~w"
+ "~n Memory total: ~w"
+ "~n"
+ "~n*********************************************"
+ "~n"
+ "~n", [WhenStr, ModFuncStr,
+ ProcCount, ProcLimit, ProcMemAlloc, ProcMemUsed,
+ ProcMemBin, ProcMemTot]),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+prepare_test_case(Actions, N, Config, File, Line) ->
+ OrigNodes = lookup_config(nodes, Config),
+ TestNodes = lookup_config(nodenames, Config), %% For testserver
+ This = node(),
+ SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes),
+ AllNodes = [This | (SomeNodes -- [This])],
+ Nodes = pick_n_nodes(N, AllNodes, File, Line),
+ start_nodes(Nodes, File, Line),
+ do_prepare_test_case(Actions, Nodes, Config, File, Line).
+
+do_prepare_test_case([init | Actions], Nodes, Config, File, Line) ->
+ process_flag(trap_exit, true),
+ megaco_test_lib:flush(),
+ do_prepare_test_case(Actions, Nodes, Config, File, Line);
+do_prepare_test_case([{stop_app, App} | Actions], Nodes, Config, File, Line) ->
+ _Res = rpc:multicall(Nodes, application, stop, [App]),
+ do_prepare_test_case(Actions, Nodes, Config, File, Line);
+do_prepare_test_case([], Nodes, _Config, _File, _Line) ->
+ Nodes.
+
+pick_n_nodes(all, AllNodes, _File, _Line) ->
+ AllNodes;
+pick_n_nodes(N, AllNodes, _File, _Line)
+ when is_integer(N) andalso (length(AllNodes) >= N) ->
+ AllNodes -- lists:nthtail(N, AllNodes);
+pick_n_nodes(N, AllNodes, File, Line) ->
+ fatal_skip({too_few_nodes, N, AllNodes}, File, Line).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+lookup_config(Key, Config) ->
+ case lists:keysearch(Key, 1, Config) of
+ {value, {Key, Val}} ->
+ Val;
+ _ ->
+ []
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+report_event(_Severity, _Label, _Content) ->
+ %% diameter:report_event(Severity, Label, Content).
+ hopefully_traced.
+
+
+p(F,A) ->
+ io:format("~p" ++ F ++ "~n", [self()|A]).
diff --git a/lib/diameter/test/diameter_test_lib.hrl b/lib/diameter/test/diameter_test_lib.hrl
new file mode 100644
index 0000000000..8b1352f801
--- /dev/null
+++ b/lib/diameter/test/diameter_test_lib.hrl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Define common macros for testing
+%%----------------------------------------------------------------------
+%%
+
+-define(FLUSH(), diameter_test_lib:flush()).
+
+-define(SLEEP(MSEC), diameter_test_lib:sleep(MSEC)).
+-define(M(), diameter_test_lib:millis()).
+-define(MDIFF(A,B), diameter_test_lib:millis_diff(A,B)).
+
+-define(HOURS(T), diameter_test_lib:hours(T)).
+-define(MINUTES(T), diameter_test_lib:minutes(T)).
+-define(SECONDS(T), diameter_test_lib:seconds(T)).
+
+-define(KEY1SEARCH(Key, L), diameter_test_lib:key1search(Key, L)).
+
+
+-define(APPLY(Proxy, Fun),
+ Proxy ! {apply, Fun}).
+
+-define(LOG(Format, Args),
+ diameter_test_lib:log(Format, Args, ?MODULE, ?LINE)).
+
+-define(ERROR(Reason),
+ diameter_test_lib:error(Reason, ?MODULE, ?LINE)).
+
+-define(OS_BASED_SKIP(Skippable),
+ diameter_test_lib:os_based_skip(Skippable)).
+
+-define(NON_PC_TC_MAYBE_SKIP(Config, Condition),
+ diameter_test_lib:non_pc_tc_maybe_skip(Config, Condition, ?MODULE, ?LINE)).
+
+-define(FAIL(Reason),
+ diameter_test_lib:fail(Reason, ?MODULE, ?LINE)).
+
+-define(SKIP(Reason),
+ diameter_test_lib:skip(Reason, ?MODULE, ?LINE)).
+
+-define(VERIFYL(Expected, Expr),
+ fun(A,B) when list(A), list(B) ->
+ A1 = lists:sort(A),
+ B1 = lists:sort(B),
+ case A1 of
+ B1 -> ?LOG("Ok, ~p~n", [B]);
+ _ -> ?ERROR(B)
+ end,
+ B;
+ (A,A) ->
+ ?LOG("Ok, ~p~n", [A]),
+ A;
+ (A,B) ->
+ ?ERROR(B),
+ B
+ end(Expected, (catch Expr))).
+
+-define(VERIFY(Expected, Expr),
+ fun() ->
+ AcTuAlReS = (catch (Expr)),
+ case AcTuAlReS of
+ Expected -> ?LOG("Ok, ~p~n", [AcTuAlReS]);
+ _ -> ?ERROR(AcTuAlReS)
+ end,
+ AcTuAlReS
+ end()).
+
+-define(RECEIVE(Expected),
+ ?VERIFY(Expected, ?FLUSH())).
+
+-define(MULTI_RECEIVE(Expected),
+ ?VERIFY(lists:sort(Expected), lists:sort(?FLUSH()))).
+
+-define(ACQUIRE_NODES(N, Config),
+ diameter_test_lib:prepare_test_case([init, {stop_app, diameter}],
+ N, Config, ?FILE, ?LINE)).
+
+
+-define(REPORT_IMPORTANT(Label, Content), ?REPORT_EVENT(20, Label, Content)).
+-define(REPORT_VERBOSE(Label, Content), ?REPORT_EVENT(40, Label, Content)).
+-define(REPORT_DEBUG(Label, Content), ?REPORT_EVENT(60, Label, Content)).
+-define(REPORT_TRACE(Label, Content), ?REPORT_EVENT(80, Label, Content)).
+
+-define(REPORT_EVENT(Severity, Label, Content),
+ diameter_test_lib:report_event(Severity, Label,
+ [{line, ?MODULE, ?LINE} | Content])).
+
diff --git a/lib/diameter/test/diameter_test_server.erl b/lib/diameter/test/diameter_test_server.erl
new file mode 100644
index 0000000000..e2ff73fb8e
--- /dev/null
+++ b/lib/diameter/test/diameter_test_server.erl
@@ -0,0 +1,551 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Lightweight test server
+%%----------------------------------------------------------------------
+
+-module(diameter_test_server).
+
+-export([
+ t/1, t/2,
+
+ init_per_testcase/2,
+ fin_per_testcase/2
+ ]).
+
+-include("diameter_test_lib.hrl").
+
+
+-define(GLOGGER, diameter_global_logger).
+
+
+%% ----------------------------------------------------------------
+%%
+
+t([Case]) when is_atom(Case) ->
+ t(Case);
+t(Case) ->
+ process_flag(trap_exit, true),
+ MEM = fun() -> case (catch erlang:memory()) of
+ {'EXIT', _} ->
+ [];
+ Res ->
+ Res
+ end
+ end,
+ Alloc1 = diameter_test_lib:alloc_info(),
+ Mem1 = MEM(),
+ Res = lists:flatten(t(Case, default_config())),
+ Alloc2 = diameter_test_lib:alloc_info(),
+ Mem2 = MEM(),
+ %% io:format("Res: ~p~n", [Res]),
+ display_result(Res, Alloc1, Mem1, Alloc2, Mem2),
+ Res.
+
+
+groups(Mod) when is_atom(Mod) ->
+ try Mod:groups() of
+ Groups when is_list(Groups) ->
+ Groups;
+ BadGroups ->
+ exit({bad_groups, Mod, BadGroups})
+ catch
+ _:_ ->
+ []
+ end.
+
+init_suite(Mod, Config) ->
+ io:format("~w:init_suite -> entry with"
+ "~n Mod: ~p"
+ "~n Config: ~p"
+ "~n", [?MODULE, Mod, Config]),
+ Mod:init_per_suite(Config).
+
+end_suite(Mod, Config) ->
+ Mod:end_per_suite(Config).
+
+init_group(Mod, Group, Config) ->
+ Mod:init_per_group(Group, Config).
+
+end_group(Mod, Group, Config) ->
+ Mod:init_per_group(Group, Config).
+
+%% This is for sub-SUITEs
+t({_Mod, {NewMod, all}, _Groups}, _Config) when is_atom(NewMod) ->
+ io:format("~w:t(all) -> entry with"
+ "~n NewMod: ~p"
+ "~n", [?MODULE, NewMod]),
+ t(NewMod);
+t({Mod, {group, Name} = Group, Groups}, Config)
+ when is_atom(Mod) andalso is_atom(Name) andalso is_list(Groups) ->
+ io:format("~w:t(group) -> entry with"
+ "~n Mod: ~p"
+ "~n Name: ~p"
+ "~n Groups: ~p"
+ "~n Config: ~p"
+ "~n", [?MODULE, Mod, Name, Groups, Config]),
+ case lists:keysearch(Name, 1, Groups) of
+ {value, {Name, _Props, GroupsAndCases}} ->
+ try init_group(Mod, Name, Config) of
+ Config2 when is_list(Config2) ->
+ Res = [t({Mod, Case, Groups}, Config2) ||
+ Case <- GroupsAndCases],
+ (catch end_group(Mod, Name, Config2)),
+ Res;
+ Error ->
+ io:format(" => group (~w) init failed: ~p~n",
+ [Name, Error]),
+ [{failed, {Mod, Group}, Error}]
+ catch
+ exit:{skipped, SkipReason} ->
+ io:format(" => skipping group: ~p~n", [SkipReason]),
+ [{skipped, {Mod, Group}, SkipReason, 0}];
+ exit:{undef, _} ->
+ [t({Mod, Case, Groups}, Config) ||
+ Case <- GroupsAndCases];
+ T:E ->
+ [{failed, {Mod, Group}, {T,E}, 0}]
+ end;
+ false ->
+ exit({unknown_group, Mod, Name, Groups})
+ end;
+t({Mod, Fun, _}, Config)
+ when is_atom(Mod) andalso is_atom(Fun) ->
+ io:format("~w:t -> entry with"
+ "~n Mod: ~p"
+ "~n Fun: ~p"
+ "~n Config: ~p"
+ "~n", [?MODULE, Mod, Fun, Config]),
+ case catch apply(Mod, Fun, [suite]) of
+ [] ->
+ io:format("Eval: ~p:", [{Mod, Fun}]),
+ Res = eval(Mod, Fun, Config),
+ {R, _, _, _} = Res,
+ io:format(" ~p~n", [R]),
+ Res;
+
+ Cases when is_list(Cases) ->
+ io:format("Expand: ~p ...~n", [{Mod, Fun}]),
+ Map = fun(Case) when is_atom(Case) -> {Mod, Case};
+ (Case) -> Case
+ end,
+ t(lists:map(Map, Cases), Config);
+
+ {'EXIT', {undef, _}} ->
+ io:format("Undefined: ~p~n", [{Mod, Fun}]),
+ [{nyi, {Mod, Fun}, ok, 0}];
+
+ Error ->
+ io:format("Ignoring: ~p: ~p~n", [{Mod, Fun}, Error]),
+ [{failed, {Mod, Fun}, Error, 0}]
+ end;
+t(Mod, Config) when is_atom(Mod) ->
+ io:format("~w:t -> entry with"
+ "~n Mod: ~p"
+ "~n Config: ~p"
+ "~n", [?MODULE, Mod, Config]),
+ %% This is assumed to be a test suite, so we start by calling
+ %% the top test suite function(s) (all/0 and groups/0).
+ case (catch Mod:all()) of
+ Cases when is_list(Cases) ->
+ %% The list may contain atoms (actual test cases) and
+ %% group-tuples (a tuple naming a group of test cases).
+ %% A group is defined by the (optional) groups/0 function.
+ io:format("~w:t -> suite all ok"
+ "~n Cases: ~p"
+ "~n", [?MODULE, Cases]),
+ Groups = groups(Mod),
+ io:format("~w:t -> "
+ "~n Groups: ~p"
+ "~n", [?MODULE, Groups]),
+ try init_suite(Mod, Config) of
+ Config2 when is_list(Config2) ->
+ io:format("~w:t -> suite init ok"
+ "~n Config2: ~p"
+ "~n", [?MODULE, Config2]),
+ Res = [t({Mod, Case, Groups}, Config2) || Case <- Cases],
+ (catch end_suite(Mod, Config2)),
+ Res;
+ Error ->
+ io:format(" => suite init failed: ~p~n", [Error]),
+ [{failed, {Mod, init_per_suite}, Error}]
+ catch
+ exit:{skipped, SkipReason} ->
+ io:format(" => skipping suite: ~p~n", [SkipReason]),
+ [{skipped, {Mod, init_per_suite}, SkipReason, 0}];
+ exit:{undef, _} ->
+ io:format("~w:t -> suite init failed. exit undef(1)~n", [?MODULE]),
+ [t({Mod, Case, Groups}, Config) || Case <- Cases];
+ exit:undef ->
+ io:format("~w:t -> suite init failed. exit undef(2)~n", [?MODULE]),
+ [t({Mod, Case, Groups}, Config) || Case <- Cases];
+ T:E ->
+ io:format("~w:t -> suite init failed. "
+ "~n T: ~p"
+ "~n E: ~p"
+ "~n", [?MODULE, T,E]),
+ [{failed, {Mod, init_per_suite}, {T,E}, 0}]
+ end;
+ {'EXIT', {undef, _}} ->
+ io:format("Undefined: ~p~n", [{Mod, all}]),
+ [{nyi, {Mod, all}, ok, 0}];
+
+ Crap ->
+ io:format("~w:t -> suite all failed: "
+ "~n Crap: ~p"
+ "~n", [?MODULE, Crap]),
+ Crap
+ end;
+t(Bad, _Config) ->
+ io:format("~w:t -> entry with"
+ "~n Bad: ~p"
+ "~n", [?MODULE, Bad]),
+ [{badarg, Bad, ok, 0}].
+
+eval(Mod, Fun, Config) ->
+ TestCase = {?MODULE, Mod, Fun},
+ Label = lists:concat(["TEST CASE: ", Fun]),
+ ?REPORT_VERBOSE(Label ++ " started", [TestCase, Config]),
+ global:register_name(diameter_test_case_sup, self()),
+ Flag = process_flag(trap_exit, true),
+ put(diameter_test_server, true),
+ Config2 = Mod:init_per_testcase(Fun, Config),
+ Self = self(),
+ Pid = spawn_link(fun() -> do_eval(Self, Mod, Fun, Config2) end),
+ R = wait_for_evaluator(Pid, Mod, Fun, Config2, []),
+ Mod:fin_per_testcase(Fun, Config2),
+ erase(diameter_test_server),
+ global:unregister_name(diameter_test_case_sup),
+ process_flag(trap_exit, Flag),
+ R.
+
+wait_for_evaluator(Pid, Mod, Fun, Config, Errors) ->
+ wait_for_evaluator(Pid, Mod, Fun, Config, Errors, 0).
+wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) ->
+ TestCase = {?MODULE, Mod, Fun},
+ Label = lists:concat(["TEST CASE: ", Fun]),
+ receive
+ {done, Pid, ok, Time} when Errors =:= [] ->
+ ?REPORT_VERBOSE(Label ++ " ok",
+ [{test_case, TestCase}, {config, Config}]),
+ {ok, {Mod, Fun}, Errors, Time};
+ {done, Pid, ok, Time} ->
+ ?REPORT_VERBOSE(Label ++ " failed",
+ [{test_case, TestCase}, {config, Config}]),
+ {failed, {Mod, Fun}, Errors, Time};
+ {done, Pid, {ok, _}, Time} when Errors =:= [] ->
+ ?REPORT_VERBOSE(Label ++ " ok",
+ [{test_case, TestCase}, {config, Config}]),
+ {ok, {Mod, Fun}, Errors, Time};
+ {done, Pid, {ok, _}, Time} ->
+ ?REPORT_VERBOSE(Label ++ " failed",
+ [{test_case, TestCase}, {config, Config}]),
+ {failed, {Mod, Fun}, Errors, Time};
+ {done, Pid, Fail, Time} ->
+ ?REPORT_IMPORTANT(Label ++ " failed",
+ [{test_case, TestCase},
+ {config, Config},
+ {return, Fail},
+ {errors, Errors}]),
+ {failed, {Mod, Fun}, Fail, Time};
+ {'EXIT', Pid, {skipped, Reason}, Time} ->
+ ?REPORT_IMPORTANT(Label ++ " skipped",
+ [{test_case, TestCase},
+ {config, Config},
+ {skipped, Reason}]),
+ {skipped, {Mod, Fun}, Errors, Time};
+ {'EXIT', Pid, Reason, Time} ->
+ ?REPORT_IMPORTANT(Label ++ " crashed",
+ [{test_case, TestCase},
+ {config, Config},
+ {'EXIT', Reason}]),
+ {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors], Time};
+ {fail, Pid, Reason, Time} ->
+ wait_for_evaluator(Pid, Mod, Fun, Config,
+ Errors ++ [Reason], AccTime + Time)
+ end.
+
+do_eval(ReplyTo, Mod, Fun, Config) ->
+ diameter_test_lib:display_system_info("before", Mod, Fun),
+ case timer:tc(Mod, Fun, [Config]) of
+ {Time, {'EXIT', {skipped, Reason}}} ->
+ display_tc_time(Time),
+ diameter_test_lib:display_system_info("after (skipped)", Mod, Fun),
+ ReplyTo ! {'EXIT', self(), {skipped, Reason}, Time};
+ {Time, {'EXIT', Reason}} ->
+ display_tc_time(Time),
+ diameter_test_lib:display_system_info("after (crashed)", Mod, Fun),
+ ReplyTo ! {'EXIT', self(), Reason, Time};
+ {Time, Other} ->
+ display_tc_time(Time),
+ diameter_test_lib:display_system_info("after", Mod, Fun),
+ ReplyTo ! {done, self(), Other, Time}
+ end,
+ unlink(ReplyTo),
+ exit(shutdown).
+
+
+display_tc_time(Time) ->
+ io:format("~n"
+ "~n*********************************************"
+ "~n"
+ "~nTest case completion time: ~.3f sec (~w)"
+ "~n", [(Time / 1000000), Time]),
+ ok.
+
+
+display_result(Res, Alloc1, Mem1, Alloc2, Mem2) ->
+ io:format("~nAllocator info: ~n", []),
+ display_alloc(Alloc1, Alloc2),
+ io:format("~nMemory info: ~n", []),
+ display_memory(Mem1, Mem2),
+ display_result(Res).
+
+display_alloc([], []) ->
+ io:format("-~n", []),
+ ok;
+display_alloc(A1, A2) ->
+ do_display_alloc(A1, A2).
+
+do_display_alloc([], _) ->
+ ok;
+do_display_alloc([{Alloc, Mem1}|AllocInfo1], AllocInfo2) ->
+ Mem2 =
+ case lists:keysearch(Alloc, 1, AllocInfo2) of
+ {value, {_, Val}} ->
+ Val;
+ false ->
+ undefined
+ end,
+ io:format("~15w: ~10w -> ~w~n", [Alloc, Mem1, Mem2]),
+ do_display_alloc(AllocInfo1, AllocInfo2).
+
+display_memory([], []) ->
+ io:format("-~n", []),
+ ok;
+display_memory(Mem1, Mem2) ->
+ do_display_memory(Mem1, Mem2).
+
+
+do_display_memory([], _) ->
+ ok;
+do_display_memory([{Key, Mem1}|MemInfo1], MemInfo2) ->
+ Mem2 =
+ case lists:keysearch(Key, 1, MemInfo2) of
+ {value, {_, Val}} ->
+ Val;
+ false ->
+ undefined
+ end,
+ io:format("~15w: ~10w -> ~w~n", [Key, Mem1, Mem2]),
+ do_display_memory(MemInfo1, MemInfo2).
+
+display_result([]) ->
+ io:format("OK~n", []);
+display_result(Res) when is_list(Res) ->
+ Ok = [{MF, Time} || {ok, MF, _, Time} <- Res],
+ Nyi = [MF || {nyi, MF, _, _Time} <- Res],
+ Skipped = [{MF, Reason} || {skipped, MF, Reason, _Time} <- Res],
+ Failed = [{MF, Reason} || {failed, MF, Reason, _Time} <- Res],
+ Crashed = [{MF, Reason} || {crashed, MF, Reason, _Time} <- Res],
+ display_summery(Ok, Nyi, Skipped, Failed, Crashed),
+ display_ok(Ok),
+ display_skipped(Skipped),
+ display_failed(Failed),
+ display_crashed(Crashed).
+
+display_summery(Ok, Nyi, Skipped, Failed, Crashed) ->
+ io:format("~nTest case summery:~n", []),
+ display_summery(Ok, "successfull"),
+ display_summery(Nyi, "not yet implemented"),
+ display_summery(Skipped, "skipped"),
+ display_summery(Failed, "failed"),
+ display_summery(Crashed, "crashed"),
+ io:format("~n", []).
+
+display_summery(Res, Info) ->
+ io:format(" ~w test cases ~s~n", [length(Res), Info]).
+
+display_ok([]) ->
+ ok;
+display_ok(Ok) ->
+ io:format("Ok test cases:~n", []),
+ F = fun({{M, F}, Time}) ->
+ io:format(" ~w : ~w => ~.2f sec~n", [M, F, Time / 1000000])
+ end,
+ lists:foreach(F, Ok),
+ io:format("~n", []).
+
+display_skipped([]) ->
+ ok;
+display_skipped(Skipped) ->
+ io:format("Skipped test cases:~n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
+ lists:foreach(F, Skipped),
+ io:format("~n", []).
+
+
+display_failed([]) ->
+ ok;
+display_failed(Failed) ->
+ io:format("Failed test cases:~n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
+ lists:foreach(F, Failed),
+ io:format("~n", []).
+
+display_crashed([]) ->
+ ok;
+display_crashed(Crashed) ->
+ io:format("Crashed test cases:~n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end,
+ lists:foreach(F, Crashed),
+ io:format("~n", []).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Test server callbacks
+init_per_testcase(_Case, Config) ->
+ Pid = group_leader(),
+ Name = ?GLOGGER,
+ case global:whereis_name(Name) of
+ undefined ->
+ global:register_name(?GLOGGER, Pid);
+ Pid ->
+ io:format("~w:init_per_testcase -> "
+ "already registered to ~p~n", [?MODULE, Pid]),
+ ok;
+ OtherPid when is_pid(OtherPid) ->
+ io:format("~w:init_per_testcase -> "
+ "already registered to other ~p (~p)~n",
+ [?MODULE, OtherPid, Pid]),
+ exit({already_registered, {?GLOGGER, OtherPid, Pid}})
+ end,
+ set_kill_timer(Config).
+
+fin_per_testcase(_Case, Config) ->
+ Name = ?GLOGGER,
+ case global:whereis_name(Name) of
+ undefined ->
+ io:format("~w:fin_per_testcase -> already un-registered~n",
+ [?MODULE]),
+ ok;
+ Pid when is_pid(Pid) ->
+ global:unregister_name(?GLOGGER),
+ ok
+ end,
+ reset_kill_timer(Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Set kill timer
+
+set_kill_timer(Config) ->
+ case init:get_argument(diameter_test_timeout) of
+ {ok, _} ->
+ Config;
+ _ ->
+ Time =
+ case lookup_config(tc_timeout, Config) of
+ [] ->
+ timer:minutes(5);
+ ConfigTime when is_integer(ConfigTime) ->
+ ConfigTime
+ end,
+ Dog =
+ case get(diameter_test_server) of
+ true ->
+ Self = self(),
+ spawn_link(fun() -> watchdog(Self, Time) end);
+ _ ->
+ test_server:timetrap(Time)
+ end,
+ [{kill_timer, Dog}|Config]
+
+
+ end.
+
+reset_kill_timer(Config) ->
+ DogKiller =
+ case get(diameter_test_server) of
+ true ->
+ fun(P) when is_pid(P) -> P ! stop;
+ (_) -> ok
+ end;
+ _ ->
+ fun(Ref) -> test_server:timetrap_cancel(Ref) end
+ end,
+ case lists:keysearch(kill_timer, 1, Config) of
+ {value, {kill_timer, Dog}} ->
+ DogKiller(Dog),
+ lists:keydelete(kill_timer, 1, Config);
+ _ ->
+ Config
+ end.
+
+watchdog(Pid, Time) ->
+ erlang:now(),
+ receive
+ stop ->
+ ok
+ after Time ->
+ case (catch process_info(Pid)) of
+ undefined ->
+ ok;
+ Info ->
+ ?LOG("<ERROR> Watchdog in test case timed out "
+ "for ~p after ~p min"
+ "~n~p"
+ "~n",
+ [Pid, Time div (1000*60), Info]),
+ exit(Pid, kill)
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+lookup_config(Key, Config) ->
+ diameter_test_lib:lookup_config(Key, Config).
+
+default_config() ->
+ [{nodes, default_nodes()}, {ts, diameter}].
+
+default_nodes() ->
+ mk_nodes(2, []).
+
+mk_nodes(0, Nodes) ->
+ Nodes;
+mk_nodes(N, []) ->
+ mk_nodes(N - 1, [node()]);
+mk_nodes(N, Nodes) when N > 0 ->
+ Head = hd(Nodes),
+ [Name, Host] = node_to_name_and_host(Head),
+ Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)].
+
+mk_node(N, Name, Host) ->
+ list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])).
+
+%% Returns [Name, Host]
+node_to_name_and_host(Node) ->
+ string:tokens(atom_to_list(Node), [$@]).
+
+
+
+
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
new file mode 100644
index 0000000000..fa8b4a8eda
--- /dev/null
+++ b/lib/diameter/test/modules.mk
@@ -0,0 +1,47 @@
+#-*-makefile-*- ; force emacs to enter makefile-mode
+
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2010. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+
+TEST_SPEC_FILE = diameter.spec
+
+COVER_SPEC_FILE = diameter.cover
+
+BEHAVIOUR_MODULES =
+
+MODULES = \
+ $(BEHAVIOUR_MODULES) \
+ diameter_SUITE \
+ diameter_app_test \
+ diameter_appup_test \
+ diameter_compiler_test \
+ diameter_config_test \
+ diameter_peer_test \
+ diameter_reg_test \
+ diameter_session_test \
+ diameter_stats_test \
+ diameter_sync_test \
+ diameter_tcp_test \
+ diameter_test_lib \
+ diameter_test_server
+
+
+INTERNAL_HRL_FILES = \
+ diameter_test_lib.hrl
+
+
+
diff --git a/lib/diameter/test/slask/diameter_persistent_table_test.erl b/lib/diameter/test/slask/diameter_persistent_table_test.erl
new file mode 100644
index 0000000000..25bbe41347
--- /dev/null
+++ b/lib/diameter/test/slask/diameter_persistent_table_test.erl
@@ -0,0 +1,495 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Verify the persistent-table component of the Diameter application
+%%----------------------------------------------------------------------
+%%
+-module(diameter_persistent_table_test).
+
+-export([
+ init_per_testcase/2, fin_per_testcase/2,
+
+ all/1,
+ suite_init/1, suite_fin/1,
+
+ simple_start_and_stop/1,
+ table_create_and_delete/1
+
+ ]).
+
+-export([t/0, t/1]).
+
+-include("diameter_test_lib.hrl").
+
+-record(command, {id, desc, cmd, verify}).
+
+
+t() -> diameter_test_server:t(?MODULE).
+t(Case) -> diameter_test_server:t({?MODULE, Case}).
+
+
+%% Test server callbacks
+init_per_testcase(Case, Config) ->
+ diameter_test_server:init_per_testcase(Case, Config).
+
+fin_per_testcase(Case, Config) ->
+ diameter_test_server:fin_per_testcase(Case, Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all(suite) ->
+ Cases =
+ [
+ simple_start_and_stop,
+ table_create_and_delete
+ ],
+ {req, [], {conf, suite_init, Cases, suite_fin}}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite_init(suite) -> [];
+suite_init(doc) -> [];
+suite_init(Config) when is_list(Config) ->
+ Config.
+
+
+suite_fin(suite) -> [];
+suite_fin(doc) -> [];
+suite_fin(Config) when is_list(Config) ->
+ Config.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Test case(s)
+%%
+
+simple_start_and_stop(suite) ->
+ [];
+simple_start_and_stop(doc) ->
+ [];
+simple_start_and_stop(Config) when is_list(Config) ->
+ diameter:enable_trace(100, io),
+ case diameter_persistent_table:start_link() of
+ {ok, Pid} ->
+ unlink(Pid);
+ {error, Reason} ->
+ exit({failed_starting, Reason})
+ end,
+
+ ok = diameter_persistent_table:stop(),
+ ok.
+
+
+table_create_and_delete(suite) ->
+ [];
+table_create_and_delete(doc) ->
+ [];
+table_create_and_delete(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+
+ %% Command range values
+ Initial = 100,
+ ClientCreation = 200,
+ Nice = 300,
+ Evil = 400,
+ End = 500,
+
+ Verbosity = min,
+ %% Verbosity = max,
+
+ Data01 = lists:sort([{a, 10}, {b, 20}, {c, 30}]),
+ Data02 = lists:sort([{x, 100}, {y, 200}, {z, 300}]),
+
+ Commands =
+ [
+ %% Initial commands
+ initial_command( Initial + 0,
+ "enable trace",
+ fun() -> diameter:enable_trace(Verbosity, io) end,
+ ok),
+ initial_command( Initial + 1,
+ "start persistent-table process",
+ fun() ->
+ case diameter_persistent_table:start_link() of
+ {ok, Pid} when is_pid(Pid) ->
+ ok;
+ Error ->
+ Error
+ end
+ end,
+ ok),
+
+ client_create_command( ClientCreation + 1,
+ "1",
+ client01),
+
+ client_create_command( ClientCreation + 2,
+ "2",
+ client02),
+
+ nice_command( Nice + 1,
+ "client 1 create table 1",
+ fun() ->
+ create_table(client01, tab01, []),
+ diameter_persistent_table:which_tables()
+ end,
+ fun([tab01] = Tabs) ->
+ {ok, Tabs};
+ (Unexpected) ->
+ {error, {bad_tables, Unexpected}}
+ end),
+
+ nice_command( Nice + 2,
+ "client 1 create table 2",
+ fun() ->
+ create_table(client01, tab02, []),
+ diameter_persistent_table:which_tables()
+ end,
+ fun([tab01, tab02] = Tabs) ->
+ {ok, Tabs};
+ ([tab02, tab01] = Tabs) ->
+ {ok, Tabs};
+ (Unexpected) ->
+ {error, {bad_tables, Unexpected}}
+ end),
+
+ nice_command( Nice + 3,
+ "client 2 create table 1",
+ fun() ->
+ create_table(client02, tab03, []),
+ diameter_persistent_table:which_tables(whereis(client02))
+ end,
+ fun([tab03] = Tabs) ->
+ {ok, Tabs};
+ (Unexpected) ->
+ {error, {bad_tables, Unexpected}}
+ end),
+
+ nice_command( Nice + 4,
+ "client 1 delete table 1",
+ fun() ->
+ delete_table(client01, tab01),
+ diameter_persistent_table:which_tables(whereis(client01))
+ end,
+ fun([tab02] = Tabs) ->
+ {ok, Tabs};
+ (Unexpected) ->
+ {error, {bad_tables, Unexpected}}
+ end),
+
+ nice_command( Nice + 5,
+ "client 1 fill in some data in tab02",
+ fun() ->
+ populate_table(client01, tab02, Data01),
+ lists:sort(ets:tab2list(tab02))
+ end,
+ fun(Data) when Data =:= Data01 ->
+ {ok, Data};
+ (Unexpected) ->
+ {error, {bad_data, Unexpected}}
+ end),
+
+ nice_command( Nice + 6,
+ "client 2 fill in some data in tab03",
+ fun() ->
+ populate_table(client02, tab03, Data02),
+ lists:sort(ets:tab2list(tab03))
+ end,
+ fun(Data) when Data =:= Data02 ->
+ {ok, Data};
+ (Unexpected) ->
+ {error, {bad_data, Unexpected}}
+ end),
+
+ nice_command( Nice + 7,
+ "simulate client 1 crash",
+ fun() ->
+ simulate_crash(client01)
+ end,
+ fun(ok) ->
+ {ok, crashed};
+ (Unexpected) ->
+ {error, {bad_simulation_result, Unexpected}}
+ end),
+
+ client_create_command( Nice + 8,
+ "1 restarted",
+ client01),
+
+ nice_command( Nice + 9,
+ "client 1 create tab02 - verify data",
+ fun() ->
+ create_table(client01, tab02, []),
+ lists:sort(ets:tab2list(tab02))
+ end,
+ fun(Data) when Data =:= Data01 ->
+ {ok, Data};
+ (Unexpected) ->
+ {error, {bad_data, Unexpected}}
+ end),
+
+ evil_command( Evil + 1,
+ "try (and fail) to delete the non-existing table tab04",
+ fun() ->
+ delete_table(client02, tab04)
+ end,
+ fun({error, {unknown_table, tab04}}) ->
+ {ok, tab04};
+ (X) ->
+ {error, {bad_result, X}}
+ end),
+
+ evil_command( Evil + 2,
+ "try (and fail) to delete a not owned table tab02",
+ fun() ->
+ delete_table(client02, tab02)
+ end,
+ fun({error, {not_owner, tab02}}) ->
+ {ok, tab02};
+ (X) ->
+ {error, {bad_result, X}}
+ end),
+
+ evil_command( Evil + 3,
+ "try (and fail) to create an already existing *and* owned table - tab03",
+ fun() ->
+ create_table(client02, tab03, [])
+ end,
+ fun({error, {already_owner, tab03}}) ->
+ {ok, tab03};
+ (X) ->
+ {error, {bad_result, X}}
+ end),
+
+ evil_command( Evil + 4,
+ "try (and fail) to create an already existing not owned table - tab02",
+ fun() ->
+ create_table(client02, tab02, [])
+ end,
+ fun({error, {not_owner, _Owner, tab02}}) ->
+ {ok, tab02};
+ (X) ->
+ {error, {bad_result, X}}
+ end),
+
+ end_command( End + 1,
+ "stop client01",
+ fun() -> stop_client(client01) end),
+
+ end_command( End + 2,
+ "stop client02",
+ fun() -> stop_client(client02) end),
+
+ end_command( End + 2,
+ "stop persistent-table",
+ fun() -> diameter_persistent_table:stop() end),
+
+ evil_command( Evil + 5,
+ "try (and fail) to stop a not running persistent-table process",
+ fun() ->
+ diameter_persistent_table:stop()
+ end,
+ fun({'EXIT', {noproc, _}}) ->
+ {ok, not_running};
+ (X) ->
+ {error, {bad_result, X}}
+ end)
+
+ ],
+
+ exec(Commands).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%
+%% Command engine
+%%
+
+exec([]) ->
+ ok;
+exec([#command{id = No,
+ desc = Desc,
+ cmd = Cmd,
+ verify = Verify}|Commands]) ->
+ io:format("Executing command ~2w: ~s: ", [No, Desc]),
+ case (catch Verify((catch Cmd()))) of
+ {ok, OK} ->
+ io:format("ok => ~p~n", [OK]),
+ exec(Commands);
+ {error, Reason} ->
+ io:format("error => ~p~n", [Reason]),
+ {error, {bad_result, No, Reason}};
+ Error ->
+ io:format("exit => ~p~n", [Error]),
+ {error, {unexpected_result, No, Error}}
+ end.
+
+initial_command(No, Desc0, Cmd, VerifyVal) when is_function(Cmd) ->
+ Desc = lists:flatten(io_lib:format("Initial - ~s", [Desc0])),
+ command(No, Desc, Cmd, VerifyVal).
+
+client_create_command(No, Desc0, Name) ->
+ Desc = lists:flatten(io_lib:format("Client create - ~s", [Desc0])),
+ Self = self(),
+ Cmd = fun() -> start_client(Self, Name) end,
+ command(No, Desc, Cmd, ok).
+
+nice_command(No, Desc0, Cmd, Verify)
+ when is_function(Cmd) andalso is_function(Verify) ->
+ Desc = lists:flatten(io_lib:format("Nice - ~s", [Desc0])),
+ command(No, Desc, Cmd, Verify).
+
+evil_command(No, Desc0, Cmd, Verify)
+ when is_function(Cmd) andalso is_function(Verify) ->
+ Desc = lists:flatten(io_lib:format("Evil - ~s", [Desc0])),
+ command(No, Desc, Cmd, Verify).
+
+end_command(No, Desc0, Cmd) when is_function(Cmd) ->
+ Desc = lists:flatten(io_lib:format("End - ~s", [Desc0])),
+ command(No, Desc, Cmd, ok).
+
+command(No, Desc, Cmd, Verify)
+ when (is_integer(No) andalso
+ is_list(Desc) andalso
+ is_function(Cmd) andalso
+ is_function(Verify)) ->
+ #command{id = No,
+ desc = Desc,
+ cmd = Cmd,
+ verify = Verify};
+command(No, Desc, Cmd, VerifyVal)
+ when (is_integer(No) andalso
+ is_list(Desc) andalso
+ is_function(Cmd)) ->
+ Verify =
+ fun(Val) ->
+ case Val of
+ VerifyVal ->
+ {ok, Val};
+ _ ->
+ {error, Val}
+ end
+ end,
+ #command{id = No,
+ desc = Desc,
+ cmd = Cmd,
+ verify = Verify}.
+
+
+start_client(Parent, Name) ->
+ ClientPid = spawn_link(fun() -> client_init(Parent, Name) end),
+ receive
+ {ClientPid, started} ->
+ ClientPid,
+ ok;
+ {'EXIT', ClientPid, Reason} ->
+ {error, {failed_starting_client, Reason}}
+ end.
+
+stop_client(Client) ->
+ Pid = whereis(Client),
+ Pid ! stop,
+ receive
+ {'EXIT', Pid, normal} ->
+ ok
+ end.
+
+create_table(Client, Tab, Opts) ->
+ Self = self(),
+ Pid = whereis(Client),
+ Pid ! {create_table, Tab, Opts, Self},
+ receive
+ {Pid, created} ->
+ ok;
+ {Pid, {create_failed, Error}} ->
+ Error
+ end.
+
+delete_table(Client, Tab) ->
+ Self = self(),
+ Pid = whereis(Client),
+ Pid ! {delete_table, Tab, Self},
+ receive
+ {Pid, deleted} ->
+ ok;
+ {Pid, {delete_failed, Error}} ->
+ Error
+ end.
+
+populate_table(Client, Tab, Data) ->
+ Self = self(),
+ Pid = whereis(Client),
+ Pid ! {populate_table, Tab, Data, Self},
+ receive
+ {Pid, populated} ->
+ ok
+ end.
+
+simulate_crash(Client) ->
+ Pid = whereis(Client),
+ Pid ! simulate_crash,
+ receive
+ {'EXIT', Pid, simulated_crash} ->
+ ok
+ end.
+
+client_init(Parent, Name) ->
+ erlang:register(Name, self()),
+ process_flag(trap_exit, true),
+ Parent ! {self(), started},
+ client_loop().
+
+client_loop() ->
+ receive
+ stop ->
+ exit(normal);
+
+ {create_table, T, Opts, From} when is_atom(T) andalso is_list(Opts) ->
+ case diameter_persistent_table:create(T, Opts) of
+ ok ->
+ From ! {self(), created};
+ Error ->
+ From ! {self(), {create_failed, Error}}
+ end,
+ client_loop();
+
+ {delete_table, T, From} ->
+ case diameter_persistent_table:delete(T) of
+ ok ->
+ From ! {self(), deleted};
+ Error ->
+ From ! {self(), {delete_failed, Error}}
+ end,
+ client_loop();
+
+ {populate_table, Tab, Data, From} ->
+ ets:insert(Tab, Data),
+ From ! {self(), populated},
+ client_loop();
+
+ simulate_crash ->
+ exit(simulated_crash)
+ end.
+