aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src
diff options
context:
space:
mode:
authorSverker Eriksson <[email protected]>2016-02-24 17:55:04 +0100
committerSverker Eriksson <[email protected]>2016-02-24 17:55:04 +0100
commit03743cd4193a2ca97f9b9a52a25e63f616e8fc07 (patch)
tree9c1f4094a2105ec4bf19dd0d16e76b598d0e608d /lib/test_server/src
parent1b094d72ffc56069c72f17c7edd673dbbfe47e39 (diff)
parent35739bd06776f90526006486b3f4ab7e54f7f951 (diff)
downloadotp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.tar.gz
otp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.tar.bz2
otp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.zip
Merge branch 'master' into sverk/master/halt-INT_MIN
Diffstat (limited to 'lib/test_server/src')
-rw-r--r--lib/test_server/src/Makefile144
-rw-r--r--lib/test_server/src/conf_vars.in25
-rw-r--r--lib/test_server/src/configure.in509
-rw-r--r--lib/test_server/src/cross.cover20
-rw-r--r--lib/test_server/src/erl2html2.erl302
-rw-r--r--lib/test_server/src/test_server.app.src39
-rw-r--r--lib/test_server/src/test_server.appup.src22
-rw-r--r--lib/test_server/src/test_server.erl2655
-rw-r--r--lib/test_server/src/test_server_ctrl.erl5646
-rw-r--r--lib/test_server/src/test_server_gl.erl301
-rw-r--r--lib/test_server/src/test_server_internal.hrl61
-rw-r--r--lib/test_server/src/test_server_io.erl452
-rw-r--r--lib/test_server/src/test_server_node.erl759
-rw-r--r--lib/test_server/src/test_server_sup.erl939
-rw-r--r--lib/test_server/src/things/distr_startup_SUITE.erl239
-rw-r--r--lib/test_server/src/things/mnesia_power_SUITE.erl126
-rw-r--r--lib/test_server/src/things/random_kill_SUITE.erl82
-rw-r--r--lib/test_server/src/things/soft.gs.txt16
-rw-r--r--lib/test_server/src/things/verify.erl200
-rw-r--r--lib/test_server/src/ts.config46
-rw-r--r--lib/test_server/src/ts.erl1019
-rw-r--r--lib/test_server/src/ts.hrl38
-rw-r--r--lib/test_server/src/ts.unix.config6
-rw-r--r--lib/test_server/src/ts.win32.config8
-rw-r--r--lib/test_server/src/ts_autoconf_win32.erl256
-rw-r--r--lib/test_server/src/ts_benchmark.erl87
-rw-r--r--lib/test_server/src/ts_erl_config.erl403
-rw-r--r--lib/test_server/src/ts_install.erl465
-rw-r--r--lib/test_server/src/ts_install_cth.erl253
-rw-r--r--lib/test_server/src/ts_lib.erl372
-rw-r--r--lib/test_server/src/ts_make.erl114
-rw-r--r--lib/test_server/src/ts_run.erl455
32 files changed, 0 insertions, 16059 deletions
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
deleted file mode 100644
index 6a26ee2933..0000000000
--- a/lib/test_server/src/Makefile
+++ /dev/null
@@ -1,144 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-
-# ----------------------------------------------------
-# Configuration info.
-# ----------------------------------------------------
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(TEST_SERVER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= test_server_ctrl \
- test_server_gl \
- test_server_io \
- test_server_node \
- test_server \
- test_server_sup \
- erl2html2
-
-TS_MODULES= \
- ts \
- ts_run \
- ts_lib \
- ts_make \
- ts_erl_config \
- ts_autoconf_win32 \
- ts_install \
- ts_install_cth \
- ts_benchmark
-
-TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
-TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%)
-
-ERL_FILES= $(MODULES:=.erl)
-TS_ERL_FILES= $(TS_MODULES:=.erl)
-HRL_FILES = ../include/test_server.hrl ../include/test_server_line.hrl
-INTERNAL_HRL_FILES = test_server_internal.hrl
-TS_HRL_FILES= ts.hrl
-C_FILES =
-AUTOCONF_FILES = configure.in conf_vars.in
-PROGRAMS = configure config.sub config.guess install-sh
-CONFIG = ts.config ts.unix.config ts.win32.config
-
-TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \
- $(APP_TARGET) $(APPUP_TARGET)
-TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(PROGRAMS) \
- $(APP_TARGET) $(APPUP_TARGET)
-TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-APP_FILE= test_server.app
-APP_SRC= $(APP_FILE).src
-APP_TARGET= $(EBIN)/$(APP_FILE)
-
-APPUP_FILE= test_server.appup
-APPUP_SRC= $(APPUP_FILE).src
-APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -I../include -Werror
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-tests debug opt: $(TARGETS) $(TS_TARGETS)
-
-clean:
- rm -f $(TARGET_FILES) $(TS_TARGET_FILES)
- rm -f core
-
-docs:
-
-configure: configure.in
- autoconf configure.in > configure
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
-
-release_tests_spec: opt
- $(INSTALL_DIR) "$(RELEASE_PATH)/test_server"
- $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \
- $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \
- $(TS_TARGET_FILES) \
- $(AUTOCONF_FILES) $(C_FILES) $(CONFIG) \
- "$(RELEASE_PATH)/test_server"
- $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server"
-
-release_docs_spec:
-
diff --git a/lib/test_server/src/conf_vars.in b/lib/test_server/src/conf_vars.in
deleted file mode 100644
index 7c55d7b9ed..0000000000
--- a/lib/test_server/src/conf_vars.in
+++ /dev/null
@@ -1,25 +0,0 @@
-CC:@CC@
-LD:@LD@
-CFLAGS:@CFLAGS@
-EI_CFLAGS:@EI_CFLAGS@
-ERTS_CFLAGS:@ERTS_CFLAGS@
-CROSSLDFLAGS:@CROSSLDFLAGS@
-SHLIB_LD:@SHLIB_LD@
-SHLIB_LDFLAGS:@SHLIB_LDFLAGS@
-SHLIB_LDLIBS:@SHLIB_LDLIBS@
-SHLIB_CFLAGS:@SHLIB_CFLAGS@
-SHLIB_EXTRACT_ALL:@SHLIB_EXTRACT_ALL@
-dll:@SHLIB_SUFFIX@
-DEFS:@DEFS@
-ERTS_LIBS:@ERTS_LIBS@
-LIBS:@LIBS@
-target_host:@target_host@
-CPU:@host_cpu@
-os:@host_os@
-target:@host@
-obj:@obj@
-exe:@exe@
-SSLEAY_ROOT:@SSLEAY_ROOT@
-JAVAC:@JAVAC@
-make_command:@make_command@
-test_c_compiler:@test_c_compiler@
diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in
deleted file mode 100644
index 001de72a1e..0000000000
--- a/lib/test_server/src/configure.in
+++ /dev/null
@@ -1,509 +0,0 @@
-dnl Process this file with autoconf to produce a configure script for Erlang.
-dnl
-dnl %CopyrightBegin%
-dnl
-dnl Copyright Ericsson AB 1997-2014. All Rights Reserved.
-dnl
-dnl Licensed under the Apache License, Version 2.0 (the "License");
-dnl you may not use this file except in compliance with the License.
-dnl You may obtain a copy of the License at
-dnl
-dnl http://www.apache.org/licenses/LICENSE-2.0
-dnl
-dnl Unless required by applicable law or agreed to in writing, software
-dnl distributed under the License is distributed on an "AS IS" BASIS,
-dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-dnl See the License for the specific language governing permissions and
-dnl limitations under the License.
-dnl
-dnl %CopyrightEnd%
-dnl
-
-AC_INIT(conf_vars.in)
-
-AC_CANONICAL_HOST
-
-dnl Checks for programs.
-AC_PROG_CC
-
-DEBUG_FLAGS="-g -DDEBUG"
-if test "$GCC" = yes; then
- DEBUG_FLAGS="$DEBUG_FLAGS -Wall $CFLAGS"
-fi
-AC_SUBST(DEBUG_FLAGS)
-
-AC_ARG_ENABLE(debug-mode,
-[ --enable-debug-mode enable debug mode],
-[ case "$enableval" in
- no) ;;
- *) CFLAGS=$DEBUG_FLAGS ;;
- esac ], )
-
-AC_ARG_ENABLE(m64-build,
-AS_HELP_STRING([--enable-m64-build],
- [build 64-bit binaries using the -m64 flag to (g)cc]),
-[ case "$enableval" in
- no) enable_m64_build=no ;;
- *) enable_m64_build=yes ;;
- esac
-],enable_m64_build=no)
-
-AC_ARG_ENABLE(m32-build,
-AS_HELP_STRING([--enable-m32-build],
- [build 32-bit binaries using the -m32 flag to (g)cc]),
-[ case "$enableval" in
- no) enable_m32_build=no ;;
- *) enable_m32_build=yes ;;
- esac
-],enable_m32_build=no)
-
-no_mXX_LDFLAGS="$LDFLAGS"
-
-if test X${enable_m64_build} = Xyes; then
- CFLAGS="-m64 $CFLAGS"
- LDFLAGS="-m64 $LDFLAGS"
-fi
-if test X${enable_m32_build} = Xyes; then
- CFLAGS="-m32 $CFLAGS"
- LDFLAGS="-m32 $LDFLAGS"
-fi
-
-AC_CHECK_LIB(m, sin)
-
-#--------------------------------------------------------------------
-# Interactive UNIX requires -linet instead of -lsocket, plus it
-# needs net/errno.h to define the socket-related error codes.
-#--------------------------------------------------------------------
-
-AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
-AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
-
-#--------------------------------------------------------------------
-# Linux/tcp.h may be needed for sockopt test in kernel
-#--------------------------------------------------------------------
-
-AC_CHECK_HEADER(linux/tcp.h, AC_DEFINE(HAVE_LINUX_TCP_H))
-AC_MSG_CHECKING(for sane linux/tcp.h)
-AC_TRY_COMPILE([#include <stdio.h>
- #include <stdlib.h>
- #include <string.h>
- #include <unistd.h>
- #include <stdarg.h>
- #include <sys/types.h>
- #include <sys/socket.h>
- #include <sys/wait.h>
- #include <linux/tcp.h>
- #include <netinet/in.h>
- #include <netdb.h>],
- [return 0;],
- have_sane_linux_tcp_h=yes,
- have_sane_linux_tcp_h=no)
-
-if test $have_sane_linux_tcp_h = yes; then
- AC_DEFINE(HAVE_SANE_LINUX_TCP_H,[1],
- [Define if we have sane linux/tcp.h])
- AC_MSG_RESULT(yes)
-else
- AC_MSG_RESULT(no)
-fi
-
-
-
-#--------------------------------------------------------------------
-# Linux requires sys/socketio.h instead of sys/sockio.h
-#--------------------------------------------------------------------
-AC_CHECK_HEADER(sys/socketio.h, AC_DEFINE(HAVE_SOCKETIO_H))
-
-
-#--------------------------------------------------------------------
-# Misc
-#--------------------------------------------------------------------
-AC_CHECK_HEADER(poll.h, AC_DEFINE(HAVE_POLL_H))
-
-#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# dynamic loading and shared libraries:
-#
-# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
-# of a shared library (may request position-independent
-# code, among other things).
-# SHLIB_LD - Base command to use for combining object files
-# into a shared library.
-# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
-# extensions. An empty string means we don't know how
-# to use shared libraries on this platform.
-#--------------------------------------------------------------------
-
-# Step 1: set the variable "system" to hold the name and version number
-# for the system.
-
-AC_MSG_CHECKING([system version (for dynamic loading)])
-system=`./config.sub $host`
-AC_MSG_RESULT($system)
-
-# Step 2: check for existence of -ldl library. This is needed because
-# Linux can use either -ldl or -ldld for dynamic loading.
-
-AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
-
-# Step 3: set configuration options based on system name and version.
-
-SHLIB_LDLIBS=
-fullSrcDir=`cd $srcdir; pwd`
-case $system in
- *-linux-*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_SUFFIX=".so"
- if test "$have_dl" = yes; then
- SHLIB_LD="${CC}"
- SHLIB_LDFLAGS="$LDFLAGS -shared"
- LD_FLAGS="-rdynamic"
- else
- AC_CHECK_HEADER(dld.h, [
- SHLIB_LD="ld"
- SHLIB_LDFLAGS="-shared"])
- if test X${enable_m64_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers)
- fi
- if test X${enable_m32_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
- fi
- fi
- SHLIB_EXTRACT_ALL=""
- ;;
- *-openbsd*)
- # Not available on all versions: check for include file.
- AC_CHECK_HEADER(dlfcn.h, [
- SHLIB_CFLAGS="-fpic"
- SHLIB_LD="${CC}"
- SHLIB_LDFLAGS="$LDFLAGS -shared"
- SHLIB_SUFFIX=".so"
- if test X${enable_m64_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers)
- fi
- if test X${enable_m32_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
- fi
- ], [
- # No dynamic loading.
- SHLIB_CFLAGS=""
- SHLIB_LD="ld"
- SHLIB_LDFLAGS=""
- SHLIB_SUFFIX=""
- AC_MSG_ERROR(don't know how to compile and link dynamic drivers)
- ])
- SHLIB_EXTRACT_ALL=""
- ;;
- *-netbsd*|*-freebsd*|*-dragonfly*)
- # Not available on all versions: check for include file.
- AC_CHECK_HEADER(dlfcn.h, [
- SHLIB_CFLAGS="-fpic"
- SHLIB_LD="ld"
- SHLIB_LDFLAGS="$LDFLAGS -Bshareable -x"
- SHLIB_SUFFIX=".so"
- if test X${enable_m64_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers)
- fi
- if test X${enable_m32_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
- fi
- ], [
- # No dynamic loading.
- SHLIB_CFLAGS=""
- SHLIB_LD="ld"
- SHLIB_LDFLAGS=""
- SHLIB_SUFFIX=""
- AC_MSG_ERROR(don't know how to compile and link dynamic drivers)
- ])
- SHLIB_EXTRACT_ALL=""
- ;;
- *-solaris2*|*-sysv4*)
- SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld"
- SHLIB_LDFLAGS="$no_mXX_LDFLAGS -G -z text"
- if test X${enable_m64_build} = Xyes; then
- SHLIB_LDFLAGS="-64 $SHLIB_LDFLAGS"
- fi
- if test X${enable_m32_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
- fi
- SHLIB_SUFFIX=".so"
- SHLIB_EXTRACT_ALL="-z allextract"
- ;;
- *darwin*)
- SHLIB_CFLAGS="-fno-common"
- SHLIB_LD="cc"
- SHLIB_LDFLAGS="$LDFLAGS -bundle -flat_namespace -undefined suppress"
- SHLIB_SUFFIX=".so"
- SHLIB_EXTRACT_ALL=""
- ;;
- *osf1*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="ld"
- SHLIB_LDFLAGS="$LDFLAGS -shared"
- if test X${enable_m64_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers)
- fi
- if test X${enable_m32_build} = Xyes; then
- AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
- fi
- SHLIB_SUFFIX=".so"
- SHLIB_EXTRACT_ALL=""
- ;;
- *osf5*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="${CC} -shared"
- SHLIB_LDFLAGS="$LDFLAGS"
- SHLIB_SUFFIX=".so"
- SHLIB_EXTRACT_ALL=""
- ;;
- *)
- # No dynamic loading.
- SHLIB_CFLAGS=""
- SHLIB_LD="ld"
- SHLIB_LDFLAGS=""
- SHLIB_LDLIBS=""
- SHLIB_SUFFIX=""
- SHLIB_EXTRACT_ALL=""
- AC_MSG_ERROR(don't know how to compile and link dynamic drivers)
- ;;
-esac
-
-# If we're running gcc, then change the C flags for compiling shared
-# libraries to the right flags for gcc, instead of those for the
-# standard manufacturer compiler.
-
-if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
- case $system in
- *-aix)
- ;;
- *-bsd*)
- ;;
- *-irix)
- ;;
- *-netbsd|*-freebsd|*-openbsd)
- ;;
- *-riscos)
- ;;
- *ultrix4.*)
- ;;
- *darwin*)
- ;;
- *)
- SHLIB_CFLAGS="-fPIC"
- ;;
- esac
-fi
-
-# Make it possible for erl_interface to use it's own compiler options
-EI_CFLAGS="$CFLAGS"
-
-# Add thread-safety flags if requested
-AC_ARG_ENABLE(shlib-thread-safety,
-[ --enable-shlib-thread-safety enable thread safety for build shared libraries],
-[ case "$enableval" in
- no) ;;
- *) SHLIB_CFLAGS="$SHLIB_CFLAGS -D_THREAD_SAFE -D_REENTRANT"
- CFLAGS="$CFLAGS -D_THREAD_SAFE -D_REENTRANT"
- ;;
- esac ], )
-
-SHLIB_CFLAGS="$SHLIB_CFLAGS $CFLAGS"
-
-
-AC_SUBST(CFLAGS)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LDFLAGS)
-AC_SUBST(SHLIB_LDLIBS)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_SUFFIX)
-AC_SUBST(SHLIB_EXTRACT_ALL)
-AC_SUBST(EI_CFLAGS)
-
-#--------------------------------------------------------------------
-# Check for the existence of the -lsocket and -lnsl libraries.
-# The order here is important, so that they end up in the right
-# order in the command line generated by make. Here are some
-# special considerations:
-# 1. Use "connect" and "accept" to check for -lsocket, and
-# "gethostbyname" to check for -lnsl.
-# 2. Use each function name only once: can't redo a check because
-# autoconf caches the results of the last check and won't redo it.
-# 3. Use -lnsl and -lsocket only if they supply procedures that
-# aren't already present in the normal libraries. This is because
-# IRIX 5.2 has libraries, but they aren't needed and they're
-# bogus: they goof up name resolution if used.
-# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
-# To get around this problem, check for both libraries together
-# if -lsocket doesn't work by itself.
-#--------------------------------------------------------------------
-
-erl_checkBoth=0
-AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1)
-if test "$erl_checkSocket" = 1; then
- AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1)
-fi
-if test "$erl_checkBoth" = 1; then
- tk_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs])
-fi
-AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
-
-dnl Checks for library functions.
-AC_CHECK_FUNCS(strerror)
-AC_CHECK_FUNCS(vsnprintf)
-AC_CHECK_FUNCS(usleep)
-
-# First check if the library is available, then if we can choose between
-# two versions of gethostbyname
-AC_HAVE_LIBRARY(resolv)
-AC_CHECK_LIB(resolv, res_gethostbyname,[AC_DEFINE(HAVE_RES_GETHOSTBYNAME,1)])
-
-#--------------------------------------------------------------------
-# Check for isfinite
-#--------------------------------------------------------------------
-
-AC_MSG_CHECKING([for isfinite])
-AC_TRY_LINK([#include <math.h>],
- [isfinite(0);], have_isfinite=yes, have_isfinite=no)
-
-if test $have_isfinite = yes; then
- AC_DEFINE(HAVE_ISFINITE,1)
- AC_MSG_RESULT(yes)
-else
- AC_DEFINE(HAVE_FINITE,1)
- AC_MSG_RESULT(no)
-fi
-
-#--------------------------------------------------------------------
-# Emulator compatible flags (for drivers)
-#--------------------------------------------------------------------
-
-ERTS_CFLAGS=$CFLAGS
-AC_SUBST(ERTS_CFLAGS)
-
-ERTS_LIBS=$LIBS
-AC_SUBST(ERTS_LIBS)
-
-#--------------------------------------------------------------------
-# Special compiler macro to handle cross compiling
-# (HCC) is used to compile tools run in the HOST environment
-#--------------------------------------------------------------------
-HCC='$(CC)'
-AC_SUBST(HCC)
-
-#--------------------------------------------------------------------
-# ld is used for linking on vxworks
-#--------------------------------------------------------------------
-LD='$(CC) $(CFLAGS)'
-AC_SUBST(LD)
-
-#--------------------------------------------------------------------
-# object file suffix
-#--------------------------------------------------------------------
-obj='.o'
-AC_SUBST(obj)
-
-#--------------------------------------------------------------------
-# executable file suffix
-#--------------------------------------------------------------------
-exe=''
-AC_SUBST(exe)
-
-#--------------------------------------------------------------------
-# flags when linking for cross platform targets (yet 'tis useful with
-# native builds)
-#--------------------------------------------------------------------
-CROSSLDFLAGS=''
-AC_SUBST(CROSSLDFLAGS)
-
-dnl
-dnl SSL and CRYPTO needs the library openSSL/ssleay
-dnl
-dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH.
-dnl If no option is given or --with-ssl is set without a path then we
-dnl search for SSL libraries and header files in the standard locations.
-dnl If set to --without-ssl we disable the use of SSL
-dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we
-dnl use "PATH/include" and "PATH/lib".
-
-AC_SUBST(SSLEAY_ROOT)
-TARGET=$host
-
-# We search for SSL. First in the OTP team ClearCase standard location,
-# then in the common OS standard locations
-# No we do not.
-SSL_APP=ssl
-CRYPTO_APP=crypto
-SSLEAY_ROOT=$TARGET
-#for dir in /usr /usr/pkg /usr/local /usr/local/ssl /usr/lib/ssl /usr/ssl; do
-# AC_CHECK_HEADER($dir/include/openssl/opensslv.h,
-# ac_cv_openssl=yes, ac_cv_openssl=no)
-# if test $ac_cv_openssl = yes ; then
-# SSLEAY_ROOT="$dir"
-# ssl_found=yes
-# break
-# fi
-#done
-
-# Find a usable java compiler
-#
-# WARNING this code is copied from ERTS configure.in, and should be
-# updated if that code changes. I hate duplicating code, but what
-# can I do.
-#
-dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY
-dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]])
-dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a
-dnl AC_LANG_JAVA instead...)
-AC_DEFUN(ERL_TRY_LINK_JAVA,
-[java_link='$JAVAC conftest.java 1>&AC_FD_CC'
-changequote(�, �)dnl
-cat > conftest.java <<EOF
-�$1�
-class conftest { public static void main(String[] args) {
- �$2�
- ; return; }}
-EOF
-changequote([, ])dnl
-if AC_TRY_EVAL(java_link) && test -s conftest.class; then
- ifelse([$3], , :, [rm -rf conftest*
- $3])
-else
- echo "configure: failed program was:" 1>&AC_FD_CC
- cat conftest.java 1>&AC_FD_CC
- echo "configure: PATH was $PATH" 1>&AC_FD_CC
-ifelse([$4], , , [ rm -rf conftest*
- $4
-])dnl
-fi
-rm -f conftest*])
-dnl
-AC_CHECK_PROGS(JAVAC, javac guavac gcj jikes bock)
-if test -n "$JAVAC"; then
- dnl Make sure it's at least JDK 1.5
- AC_CACHE_CHECK(for JDK version 1.5,
- ac_cv_prog_javac_ver_1_5,
- [ERL_TRY_LINK_JAVA([], [for (String i : args);],
- ac_cv_prog_javac_ver_1_5=yes, ac_cv_prog_javac_ver_1_5=no)])
- if test $ac_cv_prog_javac_ver_1_5 = no; then
- unset -v JAVAC
- fi
-fi
-if test -n "$JAVAC"; then
- AC_SUBST(JAVAC)
- :
-fi
-
-AC_CHECK_PROGS([make_command], [make gmake], [false])
-AC_SUBST(make_command)
-
-if test "$GCC" = yes; then
- test_c_compiler="{gnuc, undefined}"
-else
- test_c_compiler="undefined"
-fi
-AC_SUBST(test_c_compiler)
-
-AC_OUTPUT(conf_vars)
diff --git a/lib/test_server/src/cross.cover b/lib/test_server/src/cross.cover
deleted file mode 100644
index 07bf0bed5c..0000000000
--- a/lib/test_server/src/cross.cover
+++ /dev/null
@@ -1,20 +0,0 @@
-%%% This is an -*- erlang -*- file.
-%%%
-%%% Elements in this file shall be on the form
-%%% {Application,Modules}.
-%%%
-%%% Application is the name of an application or the atom all.
-%%% Modules is a list of module names
-%%%
-%%% The Application shall include the listed Modules in its cover compilation,
-%%% but not in the cover analysis.
-%%% If Application=all it means that all application shall include the listed
-%%% Modules in the cover compilation.
-%%%
-%%% After all tests are completed, the listed modules are analysed with cover
-%%% data from all tests and the result is stored under the application where
-%%% the modules belong.
-
-{all,[]}.
-
-{observer,[dbg]}.
diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl
deleted file mode 100644
index 2c63103264..0000000000
--- a/lib/test_server/src/erl2html2.erl
+++ /dev/null
@@ -1,302 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2015. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%%------------------------------------------------------------------
-%%% Purpose:Convert Erlang files to html.
-%%%------------------------------------------------------------------
-
--module(erl2html2).
--export([convert/3, convert/4]).
-
-convert([], _Dest, _InclPath) -> % Fake clause.
- ok;
-convert(File, Dest, InclPath) ->
- %% The generated code uses the BGCOLOR attribute in the
- %% BODY tag, which wasn't valid until HTML 3.2. Also,
- %% good HTML should either override all colour attributes
- %% or none of them -- *never* just a few.
- %%
- %% FIXME: The colours should *really* be set with
- %% stylesheets...
- %%
- %% The html file is written with the same encoding as the input file.
- Encoding = encoding(File),
- Header = ["<!DOCTYPE HTML PUBLIC "
- "\"-//W3C//DTD HTML 3.2 Final//EN\">\n"
- "<!-- autogenerated by '",atom_to_list(?MODULE),"'. -->\n"
- "<html>\n"
- "<head>\n"
- "<meta http-equiv=\"Content-Type\" content=\"text/html;"
- "charset=",html_encoding(Encoding),"\"/>\n"
- "<title>", to_raw_list(File,Encoding), "</title>\n"
- "</head>\n\n"
- "<body bgcolor=\"white\" text=\"black\""
- " link=\"blue\" vlink=\"purple\" alink=\"red\">\n"],
- convert(File, Dest, InclPath, Header).
-
-
-convert(File, Dest, InclPath, Header) ->
- %% statistics(runtime),
- case parse_file(File, InclPath) of
- {ok,Functions} ->
- %% {_, Time1} = statistics(runtime),
- %% io:format("Parsed file in ~.2f Seconds.~n",[Time1/1000]),
- case file:open(File,[raw,{read_ahead,10000}]) of
- {ok,SFd} ->
- case file:open(Dest,[write,raw]) of
- {ok,DFd} ->
- file:write(DFd,[Header,"<pre>\n"]),
- _Lines = build_html(SFd,DFd,encoding(File),Functions),
- file:write(DFd,["</pre>\n",footer(),
- "</body>\n</html>\n"]),
- %% {_, Time2} = statistics(runtime),
- %% io:format("Converted ~p lines in ~.2f Seconds.~n",
- %% [_Lines, Time2/1000]),
- file:close(SFd),
- file:close(DFd),
- ok;
- Error ->
- Error
- end;
- Error ->
- Error
- end;
- Error ->
- Error
- end.
-
-%%%-----------------------------------------------------------------
-%%% Parse the input file to get the line numbers for all function
-%%% definitions. This will be used when creating link targets for each
-%%% function in build_html/5.
-%%%
-%%% All function clauses are also marked in order to allow
-%%% possibly_enhance/2 to write these in bold.
-%%%
-%%% Use expanded preprocessor directives if possible (epp). Only if
-%%% this fails, fall back on using non-expanded code (epp_dodger).
-
-parse_file(File, InclPath) ->
- case epp:open(File, InclPath, []) of
- {ok,Epp} ->
- try parse_preprocessed_file(Epp,File,false) of
- Forms ->
- epp:close(Epp),
- {ok,Forms}
- catch
- _:{error,_Reason,true} ->
- parse_non_preprocessed_file(File);
- _:{error,_Reason,false} ->
- {ok,[]}
- end;
- Error = {error,_} ->
- Error
- end.
-
-parse_preprocessed_file(Epp, File, InCorrectFile) ->
- case epp:parse_erl_form(Epp) of
- {ok,Form} ->
- case Form of
- {attribute,_,file,{File,_}} ->
- parse_preprocessed_file(Epp, File, true);
- {attribute,_,file,{_OtherFile,_}} ->
- parse_preprocessed_file(Epp, File, false);
- {function,L,F,A,Cs} when InCorrectFile ->
- {CLs,LastCL} = find_clause_lines(Cs, []),
- %% tl(CLs) cause we know the start line already
- [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++
- parse_preprocessed_file(Epp, File, true);
- _ ->
- parse_preprocessed_file(Epp, File, InCorrectFile)
- end;
- {error,Reason={_L,epp,{undefined,_Macro,none}}} ->
- throw({error,Reason,InCorrectFile});
- {error,_Reason} ->
- parse_preprocessed_file(Epp, File, InCorrectFile);
- {eof,_Location} ->
- []
- end.
-
-parse_non_preprocessed_file(File) ->
- case file:open(File, []) of
- {ok,Epp} ->
- Forms = parse_non_preprocessed_file(Epp, File, 1),
- file:close(Epp),
- {ok,Forms};
- Error = {error,_E} ->
- Error
- end.
-
-parse_non_preprocessed_file(Epp, File, Location) ->
- case epp_dodger:parse_form(Epp, Location) of
- {ok,Tree,Location1} ->
- try erl_syntax:revert(Tree) of
- {function,L,F,A,Cs} ->
- {CLs,LastCL} = find_clause_lines(Cs, []),
- %% tl(CLs) cause we know the start line already
- [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++
- parse_non_preprocessed_file(Epp, File, Location1);
- _ ->
- parse_non_preprocessed_file(Epp, File, Location1)
- catch
- _:_ -> parse_non_preprocessed_file(Epp, File, Location1)
- end;
- {error,_E,Location1} ->
- parse_non_preprocessed_file(Epp, File, Location1);
- {eof,_Location} ->
- []
- end.
-
-get_line(Anno) ->
- erl_anno:line(Anno).
-
-%%%-----------------------------------------------------------------
-%%% Find the line number of the last expression in the function
-find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause
- try tuple_to_list(lists:last(Exprs)) of
- [_Type,ExprLine | _] when is_integer(ExprLine) ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)};
- [tree,_ | Exprs1] ->
- find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs);
- [macro,{_var,ExprLine,_MACRO} | _] when is_integer(ExprLine) ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)};
- _ ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)}
- catch
- _:_ ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)}
- end;
-
-find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) ->
- find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]).
-
-%%%-----------------------------------------------------------------
-%%% Add a link target for each line and one for each function definition.
-build_html(SFd,DFd,Encoding,FuncsAndCs) ->
- build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs,
- false,undefined).
-
-%% line of last expression in function found
-build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) ->
- LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8),
- file:write(DFd,["<a name=\"",
- to_raw_list(LastLineLink,Enc),"\"/>"]),
- build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined);
-%% function start line found
-build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs],
- _IsFuncDef,_FAndLastL) ->
- FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8),
- file:write(DFd,["<a name=\"",to_raw_list(FALink,Enc),"\"/>"]),
- build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL});
-build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs],
- _IsFuncDef,FAndLastL) ->
- build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL);
-build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) ->
- LStr = line_number(L),
- Str1 = line(Str,IsFuncDef),
- file:write(DFd,[LStr,Str1]),
- build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL);
-build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) ->
- L.
-
-line_number(L) ->
- LStr = integer_to_list(L),
- Pred =
- case length(LStr) of
- Length when Length < 5 ->
- lists:duplicate(5-Length,$\s);
- _ ->
- []
- end,
- ["<a name=\"",LStr,"\"/>",Pred,LStr,": "].
-
-line(Str,IsFuncDef) ->
- Str1 = htmlize(Str),
- possibly_enhance(Str1,IsFuncDef).
-
-%%%-----------------------------------------------------------------
-%%% Substitute special characters that should not appear in HTML
-htmlize([$<|Str]) ->
- [$&,$l,$t,$;|htmlize(Str)];
-htmlize([$>|Str]) ->
- [$&,$g,$t,$;|htmlize(Str)];
-htmlize([$&|Str]) ->
- [$&,$a,$m,$p,$;|htmlize(Str)];
-htmlize([$"|Str]) ->
- [$&,$q,$u,$o,$t,$;|htmlize(Str)];
-htmlize([Ch|Str]) ->
- [Ch|htmlize(Str)];
-htmlize([]) ->
- [].
-
-%%%-----------------------------------------------------------------
-%%% Write comments in italic and function definitions in bold.
-possibly_enhance(Str,true) ->
- case lists:splitwith(fun($() -> false; (_) -> true end, Str) of
- {_,[]} -> Str;
- {F,A} -> ["<b>",F,"</b>",A]
- end;
-possibly_enhance([$%|_]=Str,_) ->
- ["<i>",Str--"\n","</i>","\n"];
-possibly_enhance([$-|_]=Str,_) ->
- possibly_enhance(Str,true);
-possibly_enhance(Str,false) ->
- Str.
-
-%%%-----------------------------------------------------------------
-%%% End of the file
-footer() ->
- "".
-
-%%%-----------------------------------------------------------------
-%%% Read encoding from source file
-encoding(File) ->
- case epp:read_encoding(File) of
- none ->
- epp:default_encoding();
- E ->
- E
- end.
-
-%%%-----------------------------------------------------------------
-%%% Covert encoding atom to string for use in HTML header
-html_encoding(latin1) ->
- "iso-8859-1";
-html_encoding(utf8) ->
- "utf-8".
-
-%%%-----------------------------------------------------------------
-%%% Convert a string to a list of raw printable characters in the
-%%% given encoding. This is necessary since the files (source and
-%%% destination) are both opened in raw mode (default encoding). Byte
-%%% by byte is read from source and written to the destination. This
-%%% conversion is needed when printing data that is not first read
-%%% from the source.
-%%%
-%%% Example: if the encoding of the file is utf8, and we have a string
-%%% containing "å" = [229], then we need to convert this to [195,165]
-%%% before writing. Note that this conversion is only necessary
-%%% because the destination file is not (necessarily) opened with utf8
-%%% encoding - it is opened with default encoding in order to allow
-%%% raw file mode and byte by byte copying from source.
-to_raw_list(X,latin1) when is_list(X) ->
- X;
-to_raw_list(X,utf8) when is_list(X) ->
- binary_to_list(unicode:characters_to_binary(X)).
diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src
deleted file mode 100644
index 334be8109d..0000000000
--- a/lib/test_server/src/test_server.app.src
+++ /dev/null
@@ -1,39 +0,0 @@
-% This is an -*- erlang -*- file.
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-
-{application, test_server,
- [{description, "The OTP Test Server application"},
- {vsn, "%VSN%"},
- {modules, [
- erl2html2,
- test_server_ctrl,
- test_server,
- test_server_io,
- test_server_node,
- test_server_sup
- ]},
- {registered, [test_server_ctrl,
- test_server,
- test_server_break_process]},
- {applications, [kernel,stdlib]},
- {env, []},
- {runtime_dependencies, ["tools-2.8","stdlib-2.5","runtime_tools-1.8.16",
- "observer-2.1","kernel-4.0","inets-6.0",
- "syntax_tools-1.7","erts-7.0"]}]}.
-
diff --git a/lib/test_server/src/test_server.appup.src b/lib/test_server/src/test_server.appup.src
deleted file mode 100644
index 7c4aa630ae..0000000000
--- a/lib/test_server/src/test_server.appup.src
+++ /dev/null
@@ -1,22 +0,0 @@
-%% -*- erlang -*-
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-{"%VSN%",
- [{<<".*">>,[{restart_application, test_server}]}],
- [{<<".*">>,[{restart_application, test_server}]}]
-}.
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
deleted file mode 100644
index da6bf491ac..0000000000
--- a/lib/test_server/src/test_server.erl
+++ /dev/null
@@ -1,2655 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
--module(test_server).
-
--define(DEFAULT_TIMETRAP_SECS, 60).
-
-%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([run_test_case_apply/1,init_target_info/0,init_purify/0]).
--export([cover_compile/1,cover_analyse/2]).
-
-%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([get_loc/1,set_tc_state/1]).
-
-%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([lookup_config/2]).
--export([fail/0,fail/1,format/1,format/2,format/3]).
--export([capture_start/0,capture_stop/0,capture_get/0]).
--export([messages_get/0]).
--export([permit_io/2]).
--export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
--export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0,
- timetrap_cancel/1,timetrap_cancel/0]).
--export([m_out_of_n/3,do_times/4,do_times/2]).
--export([call_crash/3,call_crash/4,call_crash/5]).
--export([temp_name/1]).
--export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
--export([app_test/1, app_test/2, appup_test/1]).
--export([is_native/1]).
--export([comment/1, make_priv_dir/0]).
--export([os_type/0]).
--export([run_on_shielded_node/2]).
--export([is_cover/0,is_debug/0,is_commercial/0]).
-
--export([break/1,break/2,break/3,continue/0,continue/1]).
-
-%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0,
- purify_is_running/0]).
-
-%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--include("test_server_internal.hrl").
--include_lib("kernel/include/file.hrl").
-
-init_target_info() ->
- [$.|Emu] = code:objfile_extension(),
- {_, OTPRel} = init:script_id(),
- TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))),
- #target_info{os_family=test_server_sup:get_os_family(),
- os_type=os:type(),
- version=erlang:system_info(version),
- system_version=erlang:system_info(system_version),
- root_dir=code:root_dir(),
- test_server_dir=TestServerDir,
- emulator=Emu,
- otp_release=OTPRel,
- username=test_server_sup:get_username(),
- cookie=atom_to_list(erlang:get_cookie())}.
-
-init_purify() ->
- purify_new_leaks().
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) ->
-%% {ok,#cover{mods=AnalyseModules}} | {error,Reason}
-%%
-%% App = atom() , name of application to be compiled
-%% Exclude = [atom()], list of modules to exclude
-%% Include = [atom()], list of modules outside of App that should be included
-%% in the cover compilation
-%% Cross = [atoms()], list of modules outside of App shat should be included
-%% in the cover compilation, but that shall not be part of
-%% the cover analysis for this application.
-%% AnalyseModules = [atom()], list of successfully compiled modules
-%%
-%% Cover compile the given application. Return {ok,CoverInfo} if
-%% compilation succeeds, else (if application is not found and there
-%% are no modules to compile) {error,application_not_found}.
-
-cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) ->
- CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
- CompileMods = Include++CrossMods,
- case length(CompileMods) of
- 0 ->
- io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
- cover:start(), % start cover server anyway
- {ok,CoverInfo#cover{mods=[]}};
- N ->
- io:fwrite("Cover compiling ~w modules - "
- "this may take some time... ",[N]),
- do_cover_compile(CompileMods),
- io:fwrite("done\n\n",[]),
- {ok,CoverInfo#cover{mods=Include}}
- end;
-cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) ->
- CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
- CompileMods = Include++CrossMods,
- case length(CompileMods) of
- 0 ->
- io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
- cover:start(), % start cover server anyway
- {ok,CoverInfo#cover{mods=[]}};
- N ->
- io:fwrite("Cover compiling '~w' (~w files) - "
- "this may take some time... ",[App,N]),
- io:format("\nWARNING: All modules in \'~w\' are excluded\n"
- "Only cover compiling modules in include list "
- "and the modules\nin the cross cover file:\n"
- "~tp\n", [App,CompileMods]),
- do_cover_compile(CompileMods),
- io:fwrite("done\n\n",[]),
- {ok,CoverInfo#cover{mods=Include}}
- end;
-cover_compile(CoverInfo=#cover{app=App,excl=Exclude,
- incl=Include,cross=Cross}) ->
- CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
- case code:lib_dir(App) of
- {error,bad_name} ->
- case Include++CrossMods of
- [] ->
- io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
- "Not cover compiling!\n\n",[App]),
- {error,application_not_found};
- CompileMods ->
- io:fwrite("Cover compiling '~w' (~w files) - "
- "this may take some time... ",
- [App,length(CompileMods)]),
- io:format("\nWARNING: Can't find lib_dir for \'~w\'\n"
- "Only cover compiling modules in include list: "
- "~tp\n", [App,Include]),
- do_cover_compile(CompileMods),
- io:fwrite("done\n\n",[]),
- {ok,CoverInfo#cover{mods=Include}}
- end;
- LibDir ->
- EbinDir = filename:join([LibDir,"ebin"]),
- WC = filename:join(EbinDir,"*.beam"),
- AllMods = module_names(filelib:wildcard(WC)),
- AnalyseMods = (AllMods ++ Include) -- Exclude,
- CompileMods = AnalyseMods ++ CrossMods,
- case length(CompileMods) of
- 0 ->
- io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
- cover:start(), % start cover server anyway
- {ok,CoverInfo#cover{mods=[]}};
- N ->
- io:fwrite("Cover compiling '~w' (~w files) - "
- "this may take some time... ",[App,N]),
- do_cover_compile(CompileMods),
- io:fwrite("done\n\n",[]),
- {ok,CoverInfo#cover{mods=AnalyseMods}}
- end
- end.
-
-
-module_names(Beams) ->
- [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams].
-
-
-do_cover_compile(Modules) ->
- cover:start(),
- Sticky = prepare_cover_compile(Modules,[]),
- R = cover:compile_beam(Modules),
- [warn_compile(Error) || Error <- R,element(1,Error)=/=ok],
- [code:stick_mod(M) || M <- Sticky],
- ok.
-
-warn_compile({error,{Reason,Module}}) ->
- io:fwrite("\nWARNING: Could not cover compile ~ts: ~p\n",
- [Module,{error,Reason}]).
-
-%% Make sure all modules are loaded and unstick if sticky
-prepare_cover_compile([M|Ms],Sticky) ->
- case {code:is_sticky(M),code:is_loaded(M)} of
- {true,_} ->
- code:unstick_mod(M),
- prepare_cover_compile(Ms,[M|Sticky]);
- {false,false} ->
- case code:load_file(M) of
- {module,_} ->
- prepare_cover_compile([M|Ms],Sticky);
- Error ->
- io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]),
- prepare_cover_compile(Ms,Sticky)
- end;
- {false,_} ->
- prepare_cover_compile(Ms,Sticky)
- end;
-prepare_cover_compile([],Sticky) ->
- Sticky.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) ->
-%% [{M,{Cov,NotCov,Details}}]
-%%
-%% Dir = string()
-%% Analyse = details | overview
-%% Modules = [atom()], the modules to analyse
-%%
-%% Cover analysis. If Analyse==details analyse_to_file is used.
-%%
-%% If Analyse==overview analyse_to_file is not used, only an overview
-%% containing the number of covered/not covered lines in each module.
-%%
-%% Also, cover data will be exported to a file called all.coverdata in
-%% the given directory.
-%%
-%% Finally, if Stop==true, then cover will be stopped after the
-%% analysis is completed. Stopping cover causes the original (non
-%% cover compiled) modules to be loaded back in. If a process at this
-%% point is still running old code of any of the cover compiled
-%% modules, meaning that is has not done any fully qualified function
-%% call after the cover compilation, the process will now be
-%% killed. To avoid this scenario, it is possible to set Stop=false,
-%% which means that the modules will stay cover compiled. Note that
-%% this is only recommended if the erlang node is being terminated
-%% after the test is completed.
-cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) ->
- io:fwrite(user, "Cover analysing... ", []),
- {ATFOk,ATFFail} =
- case Analyse of
- details ->
- case cover:export(filename:join(Dir,"all.coverdata")) of
- ok ->
- {result,Ok1,Fail1} =
- cover:analyse_to_file(Modules,[{outdir,Dir},html]),
- {lists:map(fun(OutFile) ->
- M = list_to_atom(
- filename:basename(
- filename:rootname(OutFile,
- ".COVER.html")
- )
- ),
- {M,{file,OutFile}}
- end, Ok1),
- lists:map(fun({Reason,M}) ->
- {M,{error,Reason}}
- end, Fail1)};
- Error ->
- {[],lists:map(fun(M) -> {M,Error} end, Modules)}
- end;
- overview ->
- case cover:export(filename:join(Dir,"all.coverdata")) of
- ok ->
- {[],lists:map(fun(M) -> {M,undefined} end, Modules)};
- Error ->
- {[],lists:map(fun(M) -> {M,Error} end, Modules)}
- end
- end,
- {result,AOk,AFail} = cover:analyse(Modules,module),
- R0 = merge_analysis_results(AOk,ATFOk++ATFFail,[]) ++
- [{M,{error,Reason}} || {Reason,M} <- AFail],
- R = lists:sort(R0),
- io:fwrite(user, "done\n\n", []),
-
- case Stop of
- true ->
- Sticky = unstick_all_sticky(node()),
- cover:stop(),
- stick_all_sticky(node(),Sticky);
- false ->
- ok
- end,
- R.
-
-merge_analysis_results([{M,{Cov,NotCov}}|T],ATF,Acc) ->
- case lists:keytake(M,1,ATF) of
- {value,{_,R},ATF1} ->
- merge_analysis_results(T,ATF1,[{M,{Cov,NotCov,R}}|Acc]);
- false ->
- merge_analysis_results(T,ATF,Acc)
- end;
-merge_analysis_results([],_,Acc) ->
- Acc.
-
-do_cover_for_node(Node,CoverFunc) ->
- do_cover_for_node(Node,CoverFunc,true).
-do_cover_for_node(Node,CoverFunc,StickUnstick) ->
- %% In case a slave node is starting another slave node! I.e. this
- %% function is executed on a slave node - then the cover function
- %% must be executed on the master node. This is for instance the
- %% case in test_server's own tests.
- MainCoverNode = cover:get_main_node(),
- Sticky =
- if StickUnstick -> unstick_all_sticky(MainCoverNode,Node);
- true -> ok
- end,
- rpc:call(MainCoverNode,cover,CoverFunc,[Node]),
- if StickUnstick -> stick_all_sticky(Node,Sticky);
- true -> ok
- end.
-
-unstick_all_sticky(Node) ->
- unstick_all_sticky(node(),Node).
-unstick_all_sticky(MainCoverNode,Node) ->
- lists:filter(
- fun(M) ->
- case code:is_sticky(M) of
- true ->
- rpc:call(Node,code,unstick_mod,[M]),
- true;
- false ->
- false
- end
- end,
- rpc:call(MainCoverNode,cover,modules,[])).
-
-stick_all_sticky(Node,Sticky) ->
- lists:foreach(
- fun(M) ->
- rpc:call(Node,code,stick_mod,[M])
- end,
- Sticky).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) ->
-%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment}
-%%
-%% Time = float() (seconds)
-%% Value = term()
-%% Loc = term()
-%% Comment = string()
-%% Reason = term()
-%%
-%% Spawns off a process (case process) that actually runs the test suite.
-%% The case process will have the job process as group leader, which makes
-%% it possible to capture all it's output from io:format/2, etc.
-%%
-%% The job process then sits down and waits for news from the case process.
-%%
-%% Returns a tuple with the time spent (in seconds) in the test case,
-%% the return value from the test case or an {'EXIT',Reason} if the case
-%% failed, Loc points out where the test case crashed (if it did). Loc
-%% is either the name of the function, or {<Module>,<Line>} of the last
-%% line executed that had a ?line macro. If the test case did execute
-%% erase/0 or similar, it may be empty. Comment is the last comment added
-%% by test_server:comment/1, the reason if test_server:fail has been
-%% called or the comment given by the return value {comment,Comment} from
-%% a test case.
-%%
-%% {died,Reason,unknown,Comment} is returned if the test case was killed
-%% by some other process. Reason is the kill reason provided.
-%%
-%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a
-%% possible extension of all timetraps. Timetraps will be multiplied by
-%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all.
-%% ScaleTimetrap indicates if test_server should attemp to automatically
-%% compensate timetraps for runtime delays introduced by e.g. tools like
-%% cover.
-
-run_test_case_apply({CaseNum,Mod,Func,Args,Name,
- RunInit,TimetrapData}) ->
- purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]),
- case os:getenv("TS_RUN_VALGRIND") of
- false ->
- ok;
- _ ->
- os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++
- atom_to_list(Func)++"-")
- end,
- ProcBef = erlang:system_info(process_count),
- Result = run_test_case_apply(Mod, Func, Args, Name, RunInit,
- TimetrapData),
- ProcAft = erlang:system_info(process_count),
- purify_new_leaks(),
- DetFail = get(test_server_detected_fail),
- {Result,DetFail,ProcBef,ProcAft}.
-
--type tc_status() :: 'starting' | 'running' | 'init_per_testcase' |
- 'end_per_testcase' | {'framework',atom(),atom()} |
- 'tc'.
--record(st,
- {
- ref :: reference(),
- pid :: pid(),
- mf :: {atom(),atom()},
- last_known_loc :: term(),
- status :: tc_status() | 'undefined',
- ret_val :: term(),
- comment :: list(char()),
- timeout :: non_neg_integer() | 'infinity',
- config :: list() | 'undefined',
- end_conf_pid :: pid() | 'undefined'
- }).
-
-run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
- print_timestamp(minor,"Started at "),
- print(minor, "", [], internal_raw),
- TCCallback = get(test_server_testcase_callback),
- LogOpts = get(test_server_logopts),
- Ref = make_ref(),
- Pid =
- spawn_link(
- fun() ->
- run_test_case_eval(Mod, Func, Args, Name, Ref,
- RunInit, TimetrapData,
- LogOpts, TCCallback)
- end),
- put(test_server_detected_fail, []),
- St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown,
- status=starting,ret_val=[],comment="",timeout=infinity,
- config=hd(Args)},
- run_test_case_msgloop(St).
-
-%% Ugly bug (pre R5A):
-%% If this process (group leader of the test case) terminates before
-%% all messages have been replied back to the io server, the io server
-%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in
-%% io.erl.
-%%
-%% A test case is known to have failed if it returns {'EXIT', _} tuple,
-%% or sends a message {failed, File, Line} to it's group_leader
-%%
-run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) ->
- receive
- {set_tc_state=Tag,From,{Status,Config0}} ->
- Config = case Config0 of
- unknown -> St0#st.config;
- _ -> Config0
- end,
- St = St0#st{status=Status,config=Config},
- From ! {self(),Tag,ok},
- run_test_case_msgloop(St);
- {abort_current_testcase,_,_}=Abort when St0#st.status =:= starting ->
- %% we're in init phase, must must postpone this operation
- %% until test case execution is in progress (or FW:init_tc
- %% gets killed)
- self() ! Abort,
- erlang:yield(),
- run_test_case_msgloop(St0);
- {abort_current_testcase,Reason,From} ->
- Line = case is_process_alive(Pid) of
- true -> get_loc(Pid);
- false -> unknown
- end,
- Mon = erlang:monitor(process, Pid),
- exit(Pid,{testcase_aborted,Reason,Line}),
- erlang:yield(),
- From ! {self(),abort_current_testcase,ok},
- St = receive
- {'DOWN', Mon, process, Pid, _} ->
- St0
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- exit(Pid, kill),
- %% here's the only place we know Reason, so we save
- %% it as a comment, potentially replacing user data
- Error = lists:flatten(io_lib:format("Aborted: ~p",
- [Reason])),
- Error1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(Error,
- [$\n])]),
- Comment = if length(Error1) > 63 ->
- string:substr(Error1,1,60) ++ "...";
- true ->
- Error1
- end,
- St0#st{comment=Comment}
- end,
- run_test_case_msgloop(St);
- {sync_apply,From,MFA} ->
- do_sync_apply(false,From,MFA),
- run_test_case_msgloop(St0);
- {sync_apply_proxy,Proxy,From,MFA} ->
- do_sync_apply(Proxy,From,MFA),
- run_test_case_msgloop(St0);
- {comment,NewComment0} ->
- NewComment1 = test_server_ctrl:to_string(NewComment0),
- NewComment = test_server_sup:framework_call(format_comment,
- [NewComment1],
- NewComment1),
- run_test_case_msgloop(St0#st{comment=NewComment});
- {read_comment,From} ->
- From ! {self(),read_comment,St0#st.comment},
- run_test_case_msgloop(St0);
- {make_priv_dir,From} ->
- Config = case St0#st.config of
- undefined -> [];
- Config0 -> Config0
- end,
- Result =
- case proplists:get_value(priv_dir, Config) of
- undefined ->
- {error,no_priv_dir_in_config};
- PrivDir ->
- case file:make_dir(PrivDir) of
- ok ->
- ok;
- {error, eexist} ->
- ok;
- MkDirError ->
- {error,{MkDirError,PrivDir}}
- end
- end,
- From ! {self(),make_priv_dir,Result},
- run_test_case_msgloop(St0);
- {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
- RetVal = {Time/1000000,Value,Loc,Opts},
- St = setup_termination(RetVal, St0#st{config=undefined}),
- run_test_case_msgloop(St);
- {'EXIT',Pid,Reason} ->
- %% This exit typically happens when an unknown external process
- %% has caused a test case process to terminate (e.g. if a linked
- %% process has crashed).
- St =
- case Reason of
- {What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when
- is_integer(A) ->
- Loc = rewrite_loc_item(Loc0),
- handle_tc_exit(What, St0#st{last_known_loc=[Loc]});
- {What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when
- is_integer(A) ->
- Loc = rewrite_loc_item(Loc0),
- handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]});
- _ ->
- handle_tc_exit(Reason, St0)
- end,
- run_test_case_msgloop(St);
- {EndConfPid0,{call_end_conf,Data,_Result}} ->
- #st{mf={Mod,Func},config=CurrConf} = St0,
- case CurrConf of
- _ when is_list(CurrConf) ->
- {_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
- spawn_fw_call(Mod,Func,CurrConf,TCPid,
- TCExitReason,Loc,self()),
- St = St0#st{config=undefined,end_conf_pid=undefined},
- run_test_case_msgloop(St);
- _ ->
- run_test_case_msgloop(St0)
- end;
- {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} ->
- %% the framework has been notified, we're finished
- RetVal = {T,Value,Loc,Opts},
- Comment0 = St0#st.comment,
- Comment = case AddToComment of
- undefined ->
- Comment0;
- _ ->
- if Comment0 =:= "" ->
- AddToComment;
- true ->
- Comment0 ++
- test_server_ctrl:xhtml("<br>",
- "<br />") ++
- AddToComment
- end
- end,
- St = setup_termination(RetVal, St0#st{comment=Comment,
- config=undefined}),
- run_test_case_msgloop(St);
- {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} ->
- %% a framework function failed
- CB = os:getenv("TEST_SERVER_FRAMEWORK"),
- Loc = case CB of
- FW when FW =:= false; FW =:= "undefined" ->
- [{test_server,Func}];
- _ ->
- [{list_to_atom(CB),Func}]
- end,
- RetVal = {died,{framework_error,Loc,Error},Loc},
- St = setup_termination(RetVal, St0#st{comment="Framework error",
- config=undefined}),
- run_test_case_msgloop(St);
- {failed,File,Line} ->
- put(test_server_detected_fail,
- [{File, Line}| get(test_server_detected_fail)]),
- run_test_case_msgloop(St0);
-
- {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} ->
- case update_user_timetraps(Pid, StartTime) of
- proceed ->
- self() ! {abort_current_testcase,E,Pid};
- ignore ->
- ok
- end,
- run_test_case_msgloop(St0);
- {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} ->
- %% a user timetrap is triggered, ignore it if new
- %% timetrap has been started since
- case update_user_timetraps(Pid, StartTime) of
- proceed ->
- TotalTime = if is_integer(TrapTime) ->
- TrapTime + ElapsedTime;
- true ->
- TrapTime
- end,
- timetrap(TrapTime, TotalTime, Pid, Scale);
- ignore ->
- ok
- end,
- run_test_case_msgloop(St0);
- {timetrap_cancel_one,Handle,_From} ->
- timetrap_cancel_one(Handle, false),
- run_test_case_msgloop(St0);
- {timetrap_cancel_all,TCPid,_From} ->
- timetrap_cancel_all(TCPid, false),
- run_test_case_msgloop(St0);
- {get_timetrap_info,From,TCPid} ->
- Info = get_timetrap_info(TCPid, false),
- From ! {self(),get_timetrap_info,Info},
- run_test_case_msgloop(St0);
- _Other when not is_tuple(_Other) ->
- %% ignore anything not generated by test server
- run_test_case_msgloop(St0);
- _Other when element(1, _Other) /= 'EXIT',
- element(1, _Other) /= started,
- element(1, _Other) /= finished,
- element(1, _Other) /= print ->
- %% ignore anything not generated by test server
- run_test_case_msgloop(St0)
- after St0#st.timeout ->
- #st{ret_val=RetVal,comment=Comment} = St0,
- erlang:append_element(RetVal, Comment)
- end.
-
-setup_termination(RetVal, #st{pid=Pid}=St) ->
- timetrap_cancel_all(Pid, false),
- St#st{ret_val=RetVal,timeout=20}.
-
-set_tc_state(State) ->
- set_tc_state(State,unknown).
-set_tc_state(State, Config) ->
- tc_supervisor_req(set_tc_state, {State,Config}).
-
-handle_tc_exit(killed, St) ->
- %% probably the result of an exit(TestCase,kill) call, which is the
- %% only way to abort a testcase process that traps exits
- %% (see abort_current_testcase).
- #st{config=Config,mf={Mod,Func},pid=Pid} = St,
- Msg = testcase_aborted_or_killed,
- spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
- St;
-handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
- #st{config=Config,mf={Mod,Func},pid=Pid} = St,
- spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
- St;
-handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
- config=Config,pid=Pid}=St) ->
- R = case Reason of
- {timetrap_timeout,TVal,_} ->
- {timetrap,TVal};
- {testcase_aborted=E,AbortReason,_} ->
- {E,AbortReason};
- {fw_error,{FwMod,FwFunc,FwError}} ->
- FwError;
- Other ->
- Other
- end,
- Error = {framework_error,R},
- spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()),
- St;
-handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St)
- when is_list(Config0) ->
- {R,Loc1,F} = case Reason of
- {timetrap_timeout=E,TVal,Loc0} ->
- {{E,TVal},Loc0,E};
- {testcase_aborted=E,AbortReason,Loc0} ->
- Msg = {E,AbortReason},
- {Msg,Loc0,Msg};
- Other ->
- {{'EXIT',Other},unknown,Other}
- end,
- Timeout = end_conf_timeout(Reason, St),
- Config = [{tc_status,{failed,F}}|Config0],
- EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout),
- St#st{end_conf_pid=EndConfPid};
-handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid,
- status=Status}=St) ->
- {R,Loc1} = case Reason of
- {timetrap_timeout=E,TVal,Loc0} ->
- {{E,TVal},Loc0};
- {testcase_aborted=E,AbortReason,Loc0} ->
- {{E,AbortReason},Loc0};
- Other ->
- {{'EXIT',Other},St#st.last_known_loc}
- end,
- Func = case Status of
- init_per_testcase=F -> {F,Func0};
- end_per_testcase=F -> {F,Func0};
- _ -> Func0
- end,
- spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()),
- St.
-
-end_conf_timeout({timetrap_timeout,Timeout,_}, _) ->
- Timeout;
-end_conf_timeout(_, #st{config=Config}) when is_list(Config) ->
- proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000);
-end_conf_timeout(_, _) ->
- ?DEFAULT_TIMETRAP_SECS*1000.
-
-call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
- Starter = self(),
- Data = {Mod,Func,TCPid,TCExitReason,Loc},
- case erlang:function_exported(Mod,end_per_testcase,2) of
- false ->
- spawn_link(fun() ->
- Starter ! {self(),{call_end_conf,Data,ok}}
- end);
- true ->
- do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal)
- end.
-
-do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
- EndConfProc =
- fun() ->
- process_flag(trap_exit,true), % to catch timetraps
- Supervisor = self(),
- EndConfApply =
- fun() ->
- timetrap(TVal),
- try apply(Mod,end_per_testcase,[Func,Conf]) of
- _ -> ok
- catch
- _:Why ->
- timer:sleep(1),
- group_leader() ! {printout,12,
- "WARNING! "
- "~w:end_per_testcase(~w, ~p)"
- " crashed!\n\tReason: ~p\n",
- [Mod,Func,Conf,Why]}
- end,
- Supervisor ! {self(),end_conf}
- end,
- Pid = spawn_link(EndConfApply),
- receive
- {Pid,end_conf} ->
- Starter ! {self(),{call_end_conf,Data,ok}};
- {'EXIT',Pid,Reason} ->
- group_leader() ! {printout,12,
- "WARNING! ~w:end_per_testcase(~w, ~p)"
- " failed!\n\tReason: ~p\n",
- [Mod,Func,Conf,Reason]},
- Starter ! {self(),{call_end_conf,Data,{error,Reason}}};
- {'EXIT',_OtherPid,Reason} ->
- %% Probably the parent - not much to do about that
- exit(Reason)
- end
- end,
- spawn_link(EndConfProc).
-
-spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,
- {timetrap_timeout,TVal}=Why,
- Loc,SendTo) ->
- FwCall =
- fun() ->
- Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
- %% if init_per_testcase fails, the test case
- %% should be skipped
- try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of
- _ -> ok
- catch
- _:FwEndTCErr ->
- exit({fw_notify_done,end_tc,FwEndTCErr})
- end,
- %% finished, report back
- SendTo ! {self(),fw_notify_done,
- {TVal/1000,Skip,Loc,[],undefined}}
- end,
- spawn_link(FwCall);
-
-spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
- {timetrap_timeout,TVal}=Why,_Loc,SendTo) ->
- FwCall =
- fun() ->
- {RetVal,Report} =
- case proplists:get_value(tc_status, EndConf) of
- undefined ->
- E = {failed,{Mod,end_per_testcase,Why}},
- {E,E};
- E = {failed,Reason} ->
- {E,{error,Reason}};
- Result ->
- E = {failed,{Mod,end_per_testcase,Why}},
- {Result,E}
- end,
- group_leader() ! {printout,12,
- "WARNING! ~w:end_per_testcase(~w, ~p)"
- " failed!\n\tReason: timetrap timeout"
- " after ~w ms!\n", [Mod,Func,EndConf,TVal]},
- FailLoc = proplists:get_value(tc_fail_loc, EndConf),
- try do_end_tc_call(Mod,Func,
- {Pid,Report,[EndConf]}, Why) of
- _ -> ok
- catch
- _:FwEndTCErr ->
- exit({fw_notify_done,end_tc,FwEndTCErr})
- end,
- Warn = "<font color=\"red\">"
- "WARNING: end_per_testcase timed out!</font>",
- %% finished, report back (if end_per_testcase fails, a warning
- %% should be printed as part of the comment)
- SendTo ! {self(),fw_notify_done,
- {TVal/1000,RetVal,FailLoc,[],Warn}}
- end,
- spawn_link(FwCall);
-
-spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
- FwCall =
- fun() ->
- test_server_sup:framework_call(report, [framework_error,
- {{FwMod,FwFunc},
- FwError}]),
- Comment =
- lists:flatten(
- io_lib:format("<font color=\"red\">"
- "WARNING! ~w:~w failed!</font>",
- [FwMod,FwFunc])),
- %% finished, report back
- SendTo ! {self(),fw_notify_done,
- {died,{error,{FwMod,FwFunc,FwError}},
- {FwMod,FwFunc},[],Comment}}
- end,
- spawn_link(FwCall);
-
-spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
- Func1 = case Func of
- {_InitOrEndPerTC,F} -> F;
- F -> F
- end,
- FwCall =
- fun() ->
- try fw_error_notify(Mod,Func1,[],
- Error,Loc) of
- _ -> ok
- catch
- _:FwErrorNotifyErr ->
- exit({fw_notify_done,error_notification,
- FwErrorNotifyErr})
- end,
- Conf = [{tc_status,{failed,Error}}|CurrConf],
- try do_end_tc_call(Mod,Func1,
- {Pid,Error,[Conf]},Error) of
- _ -> ok
- catch
- _:FwEndTCErr ->
- exit({fw_notify_done,end_tc,FwEndTCErr})
- end,
- %% finished, report back
- SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
- end,
- spawn_link(FwCall).
-
-%% The job proxy process forwards messages between the test case
-%% process on a shielded node (and its descendants) and the job process.
-%%
-%% The job proxy process have to be started by the test-case process
-%% on the shielded node!
-start_job_proxy() ->
- group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok.
-
-%% The io_reply_proxy is not the most satisfying solution but it works...
-io_reply_proxy(ReplyTo) ->
- receive
- IoReply when is_tuple(IoReply),
- element(1, IoReply) == io_reply ->
- ReplyTo ! IoReply;
- _ ->
- io_reply_proxy(ReplyTo)
- end.
-
-job_proxy_msgloop() ->
- receive
-
- %%
- %% Messages that need intervention by proxy...
- %%
-
- %% io stuff ...
- IoReq when tuple_size(IoReq) >= 2,
- element(1, IoReq) == io_request ->
-
- ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end),
- group_leader() ! setelement(2, IoReq, ReplyProxy);
-
- %% test_server stuff...
- {sync_apply, From, MFA} ->
- group_leader() ! {sync_apply_proxy, self(), From, MFA};
- {sync_result_proxy, To, Result} ->
- To ! {sync_result, Result};
-
- %%
- %% Messages that need no intervention by proxy...
- %%
- Msg ->
- group_leader() ! Msg
- end,
- job_proxy_msgloop().
-
-%% A test case is known to have failed if it returns {'EXIT', _} tuple,
-%% or sends a message {failed, File, Line} to it's group_leader
-
-run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
- TimetrapData, LogOpts, TCCallback) ->
- put(test_server_multiply_timetraps, TimetrapData),
- put(test_server_logopts, LogOpts),
- Where = [{Mod,Func}],
- put(test_server_loc, Where),
-
- FWInitResult = test_server_sup:framework_call(init_tc,[Mod,Func,Args0],
- {ok,Args0}),
- set_tc_state(running),
- {{Time,Value},Loc,Opts} =
- case FWInitResult of
- {ok,Args} ->
- run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
- Error = {error,_Reason} ->
- NewResult = do_end_tc_call(Mod,Func, {Error,Args0},
- {auto_skip,{failed,Error}}),
- {{0,NewResult},Where,[]};
- {fail,Reason} ->
- Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
- fw_error_notify(Mod, Func, Conf, Reason),
- NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]},
- {fail,Reason}),
- {{0,NewResult},Where,[]};
- Skip = {SkipType,_Reason} when SkipType == skip;
- SkipType == skipped ->
- NewResult = do_end_tc_call(Mod,Func,
- {Skip,Args0}, Skip),
- {{0,NewResult},Where,[]};
- AutoSkip = {auto_skip,_Reason} ->
- %% special case where a conf case "pretends" to be skipped
- NewResult =
- do_end_tc_call(Mod,Func, {AutoSkip,Args0}, AutoSkip),
- {{0,NewResult},Where,[]}
- end,
- exit({Ref,Time,Value,Loc,Opts}).
-
-run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
- case RunInit of
- run_init ->
- set_tc_state(init_per_testcase, hd(Args)),
- ensure_timetrap(Args),
- case init_per_testcase(Mod, Func, Args) of
- Skip = {SkipType,Reason} when SkipType == skip;
- SkipType == skipped ->
- Line = get_loc(),
- Conf = [{tc_status,{skipped,Reason}}|hd(Args)],
- NewRes = do_end_tc_call(Mod,Func,
- {Skip,[Conf]}, Skip),
- {{0,NewRes},Line,[]};
- {skip_and_save,Reason,SaveCfg} ->
- Line = get_loc(),
- Conf = [{tc_status,{skipped,Reason}},
- {save_config,SaveCfg}|hd(Args)],
- NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]},
- {skip,Reason}),
- {{0,NewRes},Line,[]};
- FailTC = {fail,Reason} -> % user fails the testcase
- EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
- fw_error_notify(Mod, Func, EndConf, Reason),
- NewRes = do_end_tc_call(Mod,Func,
- {{error,Reason},[EndConf]},
- FailTC),
- {{0,NewRes},[{Mod,Func}],[]};
- {ok,NewConf} ->
- %% call user callback function if defined
- NewConf1 =
- user_callback(TCCallback, Mod, Func, init, NewConf),
- %% save current state in controller loop
- set_tc_state(tc, NewConf1),
- %% execute the test case
- {{T,Return},Loc} = {ts_tc(Mod,Func,[NewConf1]), get_loc()},
- {EndConf,TSReturn,FWReturn} =
- case Return of
- {E,TCError} when E=='EXIT' ; E==failed ->
- fw_error_notify(Mod, Func, NewConf1,
- TCError, Loc),
- {[{tc_status,{failed,TCError}},
- {tc_fail_loc,Loc}|NewConf1],
- Return,{error,TCError}};
- SaveCfg={save_config,_} ->
- {[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
- {skip_and_save,Why,SaveCfg} ->
- Skip = {skip,Why},
- {[{tc_status,{skipped,Why}},
- {save_config,SaveCfg}|NewConf1],
- Skip,Skip};
- {SkipType,Why} when SkipType == skip;
- SkipType == skipped ->
- {[{tc_status,{skipped,Why}}|NewConf1],Return,
- Return};
- _ ->
- {[{tc_status,ok}|NewConf1],Return,ok}
- end,
- %% call user callback function if defined
- EndConf1 =
- user_callback(TCCallback, Mod, Func, 'end', EndConf),
- %% update current state in controller loop
- {FWReturn1,TSReturn1,EndConf2} =
- case end_per_testcase(Mod, Func, EndConf1) of
- SaveCfg1={save_config,_} ->
- {FWReturn,TSReturn,
- [SaveCfg1|lists:keydelete(save_config,1,
- EndConf1)]};
- {fail,ReasonToFail} ->
- %% user has failed the testcase
- fw_error_notify(Mod, Func, EndConf1,
- ReasonToFail),
- {{error,ReasonToFail},
- {failed,ReasonToFail},
- EndConf1};
- {failed,{_,end_per_testcase,_}} = Failure when
- FWReturn == ok ->
- %% unexpected termination in end_per_testcase
- %% report this as the result to the framework
- {Failure,TSReturn,EndConf1};
- _ ->
- %% test case result should be reported to
- %% framework no matter the status of
- %% end_per_testcase
- {FWReturn,TSReturn,EndConf1}
- end,
- %% clear current state in controller loop
- case do_end_tc_call(Mod,Func,
- {FWReturn1,[EndConf2]}, TSReturn1) of
- {failed,Reason} = NewReturn ->
- fw_error_notify(Mod,Func,EndConf2, Reason),
- {{T,NewReturn},[{Mod,Func}],[]};
- NewReturn ->
- {{T,NewReturn},Loc,[]}
- end
- end;
- skip_init ->
- set_tc_state(running, hd(Args)),
- %% call user callback function if defined
- Args1 = user_callback(TCCallback, Mod, Func, init, Args),
- ensure_timetrap(Args1),
- %% ts_tc does a catch
- %% if this is a named conf group, the test case (init or end conf)
- %% should be called with the name as the first argument
- Args2 = if Name == undefined -> Args1;
- true -> [Name | Args1]
- end,
- %% execute the conf test case
- {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()},
- %% call user callback function if defined
- Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
- {Return2,Opts} = process_return_val([Return1], Mod, Func,
- Args1, [{Mod,Func}], Return1),
- {{T,Return2},Loc,Opts}
- end.
-
-do_end_tc_call(Mod, Func, Res, Return) ->
- FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
- Ref = make_ref(),
- if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
- case test_server_sup:framework_call(
- end_tc, [Mod,Func,Res, Return], ok) of
- {fail,FWReason} ->
- {failed,FWReason};
- ok ->
- case Return of
- {fail,Reason} ->
- {failed,Reason};
- Return ->
- Return
- end;
- NewReturn ->
- NewReturn
- end;
- true ->
- case test_server_sup:framework_call(FwMod, end_tc,
- [Mod,Func,Res], Ref) of
- {fail,FWReason} ->
- {failed,FWReason};
- _Else ->
- Return
- end
- end.
-
-%% the return value is a list and we have to check if it contains
-%% the result of an end conf case or if it's a Config list
-process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
- ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result],
- %% check if all elements in the list are valid end conf return value tuples
- case lists:all(fun(Val) when is_tuple(Val) ->
- lists:any(fun(T) -> T == element(1, Val) end,
- ReturnTags);
- (ok) ->
- true;
- (_) ->
- false
- end, Return) of
- true -> % must be return value from end conf case
- process_return_val1(Return, M,F,A, Loc, Final, []);
- false -> % must be Config value from init conf case
- case do_end_tc_call(M, F, {ok,A}, Return) of
- {failed, FWReason} = Failed ->
- fw_error_notify(M,F,A, FWReason),
- {Failed, []};
- NewReturn ->
- {NewReturn, []}
- end
- end;
-%% the return value is not a list, so it's the return value from an
-%% end conf case or it's a dummy value that can be ignored
-process_return_val(Return, M,F,A, Loc, Final) ->
- process_return_val1(Return, M,F,A, Loc, Final, []).
-
-process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
- when E=='EXIT';
- E==failed ->
- fw_error_notify(M,F,A, TCError, Loc),
- case do_end_tc_call(M,F, {{error,TCError},
- [[{tc_status,{failed,TCError}}|Args]]},
- Failed) of
- {failed,FWReason} ->
- {{failed,FWReason},SaveOpts};
- NewReturn ->
- {NewReturn,SaveOpts}
- end;
-process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args],
- Loc, Final, SaveOpts) ->
- process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts);
-process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args],
- Loc, _, SaveOpts) ->
- process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]],
- Loc, {skip,Why}, SaveOpts);
-process_return_val1([GR={return_group_result,_}|Opts], M,F,A,
- Loc, Final, SaveOpts) ->
- process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]);
-process_return_val1([RetVal={Tag,_}|Opts], M,F,A,
- Loc, _, SaveOpts) when Tag==skip;
- Tag==comment ->
- process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
-process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
- process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
-process_return_val1([], M,F,A, _Loc, Final, SaveOpts) ->
- case do_end_tc_call(M,F, {Final,A}, Final) of
- {failed,FWReason} ->
- {{failed,FWReason},SaveOpts};
- NewReturn ->
- {NewReturn,lists:reverse(SaveOpts)}
- end.
-
-user_callback(undefined, _, _, _, Args) ->
- Args;
-user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd,
- [Args]) when is_list(Args) ->
- case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
- Args1 when is_list(Args1) ->
- [Args1];
- _ ->
- [Args]
- end;
-user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) ->
- case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of
- Args1 when is_list(Args1) ->
- Args1;
- _ ->
- Args
- end.
-
-init_per_testcase(Mod, Func, Args) ->
- case code:is_loaded(Mod) of
- false -> code:load_file(Mod);
- _ -> ok
- end,
- case erlang:function_exported(Mod, init_per_testcase, 2) of
- true ->
- do_init_per_testcase(Mod, [Func|Args]);
- false ->
- %% Optional init_per_testcase is not defined -- keep quiet.
- [Config] = Args,
- {ok, Config}
- end.
-
-do_init_per_testcase(Mod, Args) ->
- try apply(Mod, init_per_testcase, Args) of
- {Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
- {skip,Reason};
- {skip_and_save,_,_}=Res ->
- Res;
- NewConf when is_list(NewConf) ->
- case lists:filter(fun(T) when is_tuple(T) -> false;
- (_) -> true end, NewConf) of
- [] ->
- {ok,NewConf};
- Bad ->
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase has returned "
- "bad elements in Config: ~p\n",[Bad]},
- {skip,{failed,{Mod,init_per_testcase,bad_return}}}
- end;
- {fail,_Reason}=Res ->
- Res;
- _Other ->
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase did not return "
- "a Config list.\n",[]},
- {skip,{failed,{Mod,init_per_testcase,bad_return}}}
- catch
- throw:{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
- {skip,Reason};
- exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
- {skip,Reason};
- throw:Other ->
- set_loc(erlang:get_stacktrace()),
- Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(Line),
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase thrown!\n"
- "\tLocation: ~ts\n\tReason: ~p\n",
- [FormattedLoc, Other]},
- {skip,{failed,{Mod,init_per_testcase,Other}}};
- _:Reason0 ->
- Stk = erlang:get_stacktrace(),
- Reason = {Reason0,Stk},
- set_loc(Stk),
- Line = get_loc(),
- FormattedLoc = test_server_sup:format_loc(Line),
- group_leader() ! {printout,12,
- "ERROR! init_per_testcase crashed!\n"
- "\tLocation: ~ts\n\tReason: ~p\n",
- [FormattedLoc,Reason]},
- {skip,{failed,{Mod,init_per_testcase,Reason}}}
- end.
-
-end_per_testcase(Mod, Func, Conf) ->
- case erlang:function_exported(Mod,end_per_testcase,2) of
- true ->
- do_end_per_testcase(Mod,end_per_testcase,Func,Conf);
- false ->
- %% Backwards compatibility!
- case erlang:function_exported(Mod,fin_per_testcase,2) of
- true ->
- do_end_per_testcase(Mod,fin_per_testcase,Func,Conf);
- false ->
- ok
- end
- end.
-
-do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
- set_tc_state(end_per_testcase, Conf),
- try Mod:EndFunc(Func, Conf) of
- {save_config,_}=SaveCfg ->
- SaveCfg;
- {fail,_}=Fail ->
- Fail;
- _ ->
- ok
- catch
- throw:Other ->
- Comment0 = case read_comment() of
- "" -> "";
- Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
- "<br />")
- end,
- set_loc(erlang:get_stacktrace()),
- comment(io_lib:format("~ts<font color=\"red\">"
- "WARNING: ~w thrown!"
- "</font>\n",[Comment0,EndFunc])),
- group_leader() ! {printout,12,
- "WARNING: ~w thrown!\n"
- "Reason: ~p\n"
- "Line: ~ts\n",
- [EndFunc, Other,
- test_server_sup:format_loc(get_loc())]},
- {failed,{Mod,end_per_testcase,Other}};
- Class:Reason ->
- Stk = erlang:get_stacktrace(),
- set_loc(Stk),
- Why = case Class of
- exit -> {'EXIT',Reason};
- error -> {'EXIT',{Reason,Stk}}
- end,
- Comment0 = case read_comment() of
- "" -> "";
- Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
- "<br />")
- end,
- comment(io_lib:format("~ts<font color=\"red\">"
- "WARNING: ~w crashed!"
- "</font>\n",[Comment0,EndFunc])),
- group_leader() ! {printout,12,
- "WARNING: ~w crashed!\n"
- "Reason: ~p\n"
- "Line: ~ts\n",
- [EndFunc, Reason,
- test_server_sup:format_loc(get_loc())]},
- {failed,{Mod,end_per_testcase,Why}}
- end.
-
-get_loc() ->
- get(test_server_loc).
-
-get_loc(Pid) ->
- [{current_stacktrace,Stk0},{dictionary,Dict}] =
- process_info(Pid, [current_stacktrace,dictionary]),
- lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
- Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
- case get(test_server_loc) of
- [{Suite,Case}] ->
- %% Location info unknown, check if {Suite,Case,Line}
- %% is available in stacktrace and if so, use stacktrace
- %% instead of current test_server_loc.
- %% If location is the last expression in a test case
- %% function, the info is not available due to tail call
- %% elimination. We need to check if the test case has been
- %% called by ts_tc/3 and, if so, insert the test case info
- %% at that position.
- case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
- [match|_] ->
- put(test_server_loc, Stk);
- _ ->
- {PreTC,PostTC} =
- lists:splitwith(fun({test_server,ts_tc,_}) ->
- false;
- (_) ->
- true
- end, Stk),
- if PostTC == [] ->
- ok;
- true ->
- put(test_server_loc,
- PreTC++[{Suite,Case,last_expr} | PostTC])
- end
- end;
- _ ->
- put(test_server_loc, Stk)
- end,
- get_loc().
-
-fw_error_notify(Mod, Func, Args, Error) ->
- test_server_sup:framework_call(error_notification,
- [Mod,Func,[Args],
- {Error,unknown}]).
-fw_error_notify(Mod, Func, Args, Error, Loc) ->
- test_server_sup:framework_call(error_notification,
- [Mod,Func,[Args],
- {Error,Loc}]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% print(Detail,Format,Args,Printer) -> ok
-%% Detail = integer()
-%% Format = string()
-%% Args = [term()]
-%%
-%% Just like io:format, except that depending on the Detail value, the output
-%% is directed to console, major and/or minor log files.
-
-%% print(Detail,Format,Args) ->
-%% test_server_ctrl:print(Detail, Format, Args).
-
-print(Detail,Format,Args,Printer) ->
- test_server_ctrl:print(Detail, Format, Args, Printer).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% print_timsteamp(Detail,Leader) -> ok
-%%
-%% Prints Leader followed by a time stamp (date and time). Depending on
-%% the Detail value, the output is directed to console, major and/or minor
-%% log files.
-
-print_timestamp(Detail,Leader) ->
- test_server_ctrl:print_timestamp(Detail, Leader).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined
-%% Key = term()
-%% Value = term()
-%% Config = [{Key,Value},...]
-%%
-%% Looks up a specific key in the config list, and returns the value
-%% of the associated key, or undefined if the key doesn't exist.
-
-lookup_config(Key,Config) ->
- case lists:keysearch(Key,1,Config) of
- {value,{Key,Val}} ->
- Val;
- _ ->
- io:format("Could not find element ~p in Config.~n",[Key]),
- undefined
- end.
-
-%%
-%% IMPORTANT: get_loc/1 uses the name of this function when analysing
-%% stack traces. If the name changes, get_loc/1 must be updated!
-%%
-ts_tc(M, F, A) ->
- Before = erlang:monotonic_time(),
- Result = try
- apply(M, F, A)
- catch
- throw:{skip, Reason} -> {skip, Reason};
- throw:{skipped, Reason} -> {skip, Reason};
- exit:{skip, Reason} -> {skip, Reason};
- exit:{skipped, Reason} -> {skip, Reason};
- Type:Reason ->
- Stk = erlang:get_stacktrace(),
- set_loc(Stk),
- case Type of
- throw ->
- {failed,{thrown,Reason}};
- error ->
- {'EXIT',{Reason,Stk}};
- exit ->
- {'EXIT',Reason}
- end
- end,
- After = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds),
- {Elapsed, Result}.
-
-set_loc(Stk) ->
- Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of
- [{M,F,0}|Stack] ->
- [{M,F}|Stack];
- Other ->
- Other
- end,
- put(test_server_loc, Loc).
-
-rewrite_loc_item({M,F,_,Loc}) ->
- {M,F,proplists:get_value(line, Loc, 0)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% TEST SUITE SUPPORT FUNCTIONS %%
-%% %%
-%% Note: Some of these functions have been moved to test_server_sup %%
-%% in an attempt to keep this modules small (yeah, right!) %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% format(Format) -> IoLibReturn
-%% format(Detail,Format) -> IoLibReturn
-%% format(Format,Args) -> IoLibReturn
-%% format(Detail,Format,Args) -> IoLibReturn
-%% Detail = integer()
-%% Format = string()
-%% Args = [term(),...]
-%% IoLibReturn = term()
-%%
-%% Logs the Format string and Args, similar to io:format/1/2 etc. If
-%% Detail is not specified, the default detail level (which is 50) is used.
-%% Which log files the string will be logged in depends on the thresholds
-%% set with set_levels/3. Typically with default detail level, only the
-%% minor log file is used.
-format(Format) ->
- format(minor, Format, []).
-
-format(major, Format) ->
- format(major, Format, []);
-format(minor, Format) ->
- format(minor, Format, []);
-format(Detail, Format) when is_integer(Detail) ->
- format(Detail, Format, []);
-format(Format, Args) ->
- format(minor, Format, Args).
-
-format(Detail, Format, Args) ->
- Str =
- case catch io_lib:format(Format,Args) of
- {'EXIT',_} ->
- io_lib:format("illegal format; ~p with args ~p.\n",
- [Format,Args]);
- Valid -> Valid
- end,
- log({Detail, Str}).
-
-log(Msg) ->
- group_leader() ! {structured_io, self(), Msg},
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% capture_start() -> ok
-%% capture_stop() -> ok
-%%
-%% Starts/stops capturing all output from io:format, and similar. Capturing
-%% output doesn't stop output from happening. It just makes it possible
-%% to retrieve the output using capture_get/0.
-%% Starting and stopping capture doesn't affect already captured output.
-%% All output is stored as messages in the message queue until retrieved
-
-capture_start() ->
- group_leader() ! {capture,self()},
- ok.
-
-capture_stop() ->
- group_leader() ! {capture,false},
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% capture_get() -> Output
-%% Output = [string(),...]
-%%
-%% Retrieves all the captured output since last call to capture_get/0.
-%% Note that since output arrive as messages to the process, it takes
-%% a short while from the call to io:format until all output is available
-%% by capture_get/0. It is not necessary to call capture_stop/0 before
-%% retreiving the output.
-capture_get() ->
- test_server_sup:capture_get([]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% messages_get() -> Messages
-%% Messages = [term(),...]
-%%
-%% Returns all messages in the message queue.
-messages_get() ->
- test_server_sup:messages_get([]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% permit_io(GroupLeader, FromPid) -> ok
-%%
-%% Make sure proceeding IO from FromPid won't get rejected
-permit_io(GroupLeader, FromPid) ->
- GroupLeader ! {permit_io,FromPid}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% sleep(Time) -> ok
-%% Time = integer() | float() | infinity
-%%
-%% Sleeps the specified number of milliseconds. This sleep also accepts
-%% floating point numbers (which are truncated) and the atom 'infinity'.
-sleep(infinity) ->
- receive
- after infinity ->
- ok
- end;
-sleep(MSecs) ->
- receive
- after trunc(MSecs) ->
- ok
- end,
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% adjusted_sleep(Time) -> ok
-%% Time = integer() | float() | infinity
-%%
-%% Sleeps the specified number of milliseconds, multiplied by the
-%% 'multiply_timetraps' value (if set) and possibly also automatically scaled
-%% up if 'scale_timetraps' is set to true (which is default).
-%% This function also accepts floating point numbers (which are truncated) and
-%% the atom 'infinity'.
-adjusted_sleep(infinity) ->
- receive
- after infinity ->
- ok
- end;
-adjusted_sleep(MSecs) ->
- {Multiplier,ScaleFactor} =
- case test_server_ctrl:get_timetrap_parameters() of
- {undefined,undefined} ->
- {1,1};
- {undefined,false} ->
- {1,1};
- {undefined,true} ->
- {1,timetrap_scale_factor()};
- {infinity,_} ->
- {infinity,1};
- {Mult,undefined} ->
- {Mult,1};
- {Mult,false} ->
- {Mult,1};
- {Mult,true} ->
- {Mult,timetrap_scale_factor()}
- end,
- receive
- after trunc(MSecs*Multiplier*ScaleFactor) ->
- ok
- end,
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% fail(Reason) -> exit({suite_failed,Reason})
-%%
-%% Immediately calls exit. Included because test suites are easier
-%% to read when using this function, rather than exit directly.
-fail(Reason) ->
- comment(cast_to_list(Reason)),
- try
- exit({suite_failed,Reason})
- catch
- Class:R ->
- case erlang:get_stacktrace() of
- [{?MODULE,fail,1,_}|Stk] -> ok;
- Stk -> ok
- end,
- erlang:raise(Class, R, Stk)
- end.
-
-cast_to_list(X) when is_list(X) -> X;
-cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])).
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% fail() -> exit(suite_failed)
-%%
-%% Immediately calls exit. Included because test suites are easier
-%% to read when using this function, rather than exit directly.
-fail() ->
- try
- exit(suite_failed)
- catch
- Class:R ->
- case erlang:get_stacktrace() of
- [{?MODULE,fail,0,_}|Stk] -> ok;
- Stk -> ok
- end,
- erlang:raise(Class, R, Stk)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% break(Comment) -> ok
-%%
-%% Break a test case so part of the test can be done manually.
-%% Use continue/0 to continue.
-break(Comment) ->
- break(?MODULE, Comment).
-
-break(CBM, Comment) ->
- break(CBM, '', Comment).
-
-break(CBM, TestCase, Comment) ->
- timetrap_cancel(),
- {TCName,CntArg,PName} =
- if TestCase == '' ->
- {"", "", test_server_break_process};
- true ->
- Str = atom_to_list(TestCase),
- {[32 | Str], Str,
- list_to_atom("test_server_break_process_" ++ Str)}
- end,
- io:format(user,
- "\n\n\n--- SEMIAUTOMATIC TESTING ---"
- "\nThe test case~ts executes on process ~w"
- "\n\n\n~ts"
- "\n\n\n-----------------------------\n\n"
- "Continue with --> ~w:continue(~ts).\n",
- [TCName,self(),Comment,CBM,CntArg]),
- case whereis(PName) of
- undefined ->
- spawn_break_process(self(), PName);
- OldBreakProcess ->
- OldBreakProcess ! cancel,
- spawn_break_process(self(), PName)
- end,
- receive continue -> ok end.
-
-spawn_break_process(Pid, PName) ->
- spawn(fun() ->
- register(PName, self()),
- receive
- continue -> continue(Pid);
- cancel -> ok
- end
- end).
-
-continue() ->
- case whereis(test_server_break_process) of
- undefined -> ok;
- BreakProcess -> BreakProcess ! continue
- end.
-
-continue(TestCase) when is_atom(TestCase) ->
- PName = list_to_atom("test_server_break_process_" ++
- atom_to_list(TestCase)),
- case whereis(PName) of
- undefined -> ok;
- BreakProcess -> BreakProcess ! continue
- end;
-
-continue(Pid) when is_pid(Pid) ->
- Pid ! continue.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap_scale_factor() -> Factor
-%%
-%% Returns the amount to scale timetraps with.
-
-%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true
-timetrap_scale_factor() ->
- timetrap_scale_factor([
- { 2, fun() -> has_lock_checking() end},
- { 3, fun() -> has_superfluous_schedulers() end},
- { 5, fun() -> purify_is_running() end},
- { 6, fun() -> is_debug() end},
- {10, fun() -> is_cover() end}
- ]).
-
-timetrap_scale_factor(Scales) ->
- %% The fun in {S, Fun} a filter input to the list comprehension
- lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap(Timeout) -> Handle
-%% Handle = term()
-%%
-%% Creates a time trap, that will kill the calling process if the
-%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds.
-timetrap(Timeout) ->
- MultAndScale =
- case get(test_server_multiply_timetraps) of
- undefined -> {fun(T) -> T end, true};
- {undefined,false} -> {fun(T) -> T end, false};
- {undefined,_} -> {fun(T) -> T end, true};
- {infinity,_} -> {fun(_) -> infinity end, false};
- {Int,Scale} -> {fun(infinity) -> infinity;
- (T) -> T*Int end, Scale}
- end,
- timetrap(Timeout, Timeout, self(), MultAndScale).
-
-%% when the function is called from different process than
-%% the test case, the test_server_multiply_timetraps data
-%% is unknown and must be passed as argument
-timetrap(Timeout, TCPid, MultAndScale) ->
- timetrap(Timeout, Timeout, TCPid, MultAndScale).
-
-timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) ->
- %% the time_ms call will either convert Timeout to ms or spawn a
- %% user timetrap which sends the result to the IO server process
- Timeout = time_ms(Timeout0, TCPid, MultAndScale),
- Timeout1 = Multiplier(Timeout),
- TimeToReport = if Timeout0 == TimeToReport0 ->
- Timeout1;
- true ->
- %% only convert to ms, don't start a
- %% user timetrap
- time_ms_check(TimeToReport0)
- end,
- cancel_default_timetrap(self() == TCPid),
- Handle = case Timeout1 of
- infinity ->
- infinity;
- _ ->
- spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport,
- Scale,TCPid])
- end,
-
- %% ERROR! This sets dict on IO process instead of testcase process
- %% if Timeout is return value from previous user timetrap!!
-
- case get(test_server_timetraps) of
- undefined ->
- put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]);
- List ->
- List1 = lists:delete({infinity,TCPid,{infinity,false}}, List),
- put(test_server_timetraps,[{Handle,TCPid,
- {TimeToReport,Scale}}|List1])
- end,
- Handle.
-
-ensure_timetrap(Config) ->
- case get(test_server_timetraps) of
- [_|_] ->
- ok;
- _ ->
- case get(test_server_default_timetrap) of
- undefined -> ok;
- Garbage ->
- erase(test_server_default_timetrap),
- format("=== WARNING: garbage in "
- "test_server_default_timetrap: ~p~n",
- [Garbage])
- end,
- DTmo = case lists:keysearch(default_timeout,1,Config) of
- {value,{default_timeout,Tmo}} -> Tmo;
- _ -> ?DEFAULT_TIMETRAP_SECS
- end,
- format("=== test_server setting default "
- "timetrap of ~p seconds~n",
- [DTmo]),
- put(test_server_default_timetrap, timetrap(seconds(DTmo)))
- end.
-
-%% executing on IO process, no default timetrap ever set here
-cancel_default_timetrap(false) ->
- ok;
-cancel_default_timetrap(true) ->
- case get(test_server_default_timetrap) of
- undefined ->
- ok;
- TimeTrap when is_pid(TimeTrap) ->
- timetrap_cancel(TimeTrap),
- erase(test_server_default_timetrap),
- format("=== test_server canceled default timetrap "
- "since another timetrap was set~n"),
- ok;
- Garbage ->
- erase(test_server_default_timetrap),
- format("=== WARNING: garbage in "
- "test_server_default_timetrap: ~p~n",
- [Garbage]),
- error
- end.
-
-time_ms({hours,N}, _, _) -> hours(N);
-time_ms({minutes,N}, _, _) -> minutes(N);
-time_ms({seconds,N}, _, _) -> seconds(N);
-time_ms({Other,_N}, _, _) ->
- format("=== ERROR: Invalid time specification: ~p. "
- "Should be seconds, minutes, or hours.~n", [Other]),
- exit({invalid_time_format,Other});
-time_ms(Ms, _, _) when is_integer(Ms) -> Ms;
-time_ms(infinity, _, _) -> infinity;
-time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) ->
- time_ms_apply(Fun, TCPid, MultAndScale);
-time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M),
- is_atom(F),
- is_list(A) ->
- time_ms_apply(MFA, TCPid, MultAndScale);
-time_ms(Other, _, _) -> exit({invalid_time_format,Other}).
-
-time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
- MFA;
-time_ms_check(Fun) when is_function(Fun) ->
- Fun;
-time_ms_check(Other) ->
- time_ms(Other, undefined, undefined).
-
-time_ms_apply(Func, TCPid, MultAndScale) ->
- {_,GL} = process_info(TCPid, group_leader),
- WhoAmI = self(), % either TC or IO server
- T0 = erlang:monotonic_time(),
- UserTTSup =
- spawn(fun() ->
- user_timetrap_supervisor(Func, WhoAmI, TCPid,
- GL, T0, MultAndScale)
- end),
- receive
- {UserTTSup,infinity} ->
- %% remember the user timetrap so that it can be cancelled
- save_user_timetrap(TCPid, UserTTSup, T0),
- %% we need to make sure the user timetrap function
- %% gets time to execute and return
- timetrap(infinity, TCPid, MultAndScale)
- after 5000 ->
- exit(UserTTSup, kill),
- if WhoAmI /= GL ->
- exit({user_timetrap_error,time_ms_apply});
- true ->
- format("=== ERROR: User timetrap execution failed!", []),
- ignore
- end
- end.
-
-user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) ->
- process_flag(trap_exit, true),
- Spawner ! {self(),infinity},
- MonRef = monitor(process, TCPid),
- UserTTSup = self(),
- group_leader(GL, UserTTSup),
- UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end),
- receive
- {UserTT,Result} ->
- demonitor(MonRef, [flush]),
- T1 = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds),
- try time_ms_check(Result) of
- TimeVal ->
- %% this is the new timetrap value to set (return value
- %% from a fun or an MFA)
- GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale}
- catch _:_ ->
- %% when other than a legal timetrap value is returned
- %% which will be the normal case for user timetraps
- GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale}
- end;
- {'EXIT',UserTT,Error} when Error /= normal ->
- demonitor(MonRef, [flush]),
- GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error},
- MultAndScale};
- {'DOWN',MonRef,_,_,_} ->
- demonitor(MonRef, [flush]),
- exit(UserTT, kill)
- end.
-
-call_user_timetrap(Func, Sup) when is_function(Func) ->
- try Func() of
- Result ->
- Sup ! {self(),Result}
- catch _:Error ->
- exit({Error,erlang:get_stacktrace()})
- end;
-call_user_timetrap({M,F,A}, Sup) ->
- try apply(M,F,A) of
- Result ->
- Sup ! {self(),Result}
- catch _:Error ->
- exit({Error,erlang:get_stacktrace()})
- end.
-
-save_user_timetrap(TCPid, UserTTSup, StartTime) ->
- %% save pid of user timetrap supervisor process so that
- %% it may be stopped even before the timetrap func has returned
- NewUserTT = {TCPid,{UserTTSup,StartTime}},
- case get(test_server_user_timetrap) of
- undefined ->
- put(test_server_user_timetrap, [NewUserTT]);
- UserTTSups ->
- case proplists:get_value(TCPid, UserTTSups) of
- undefined ->
- put(test_server_user_timetrap,
- [NewUserTT | UserTTSups]);
- PrevTTSup ->
- %% remove prev user timetrap
- remove_user_timetrap(PrevTTSup),
- put(test_server_user_timetrap,
- [NewUserTT | proplists:delete(TCPid,
- UserTTSups)])
- end
- end.
-
-update_user_timetraps(TCPid, StartTime) ->
- %% called when a user timetrap is triggered
- case get(test_server_user_timetrap) of
- undefined ->
- proceed;
- UserTTs ->
- case proplists:get_value(TCPid, UserTTs) of
- {_UserTTSup,StartTime} -> % same timetrap
- put(test_server_user_timetrap,
- proplists:delete(TCPid, UserTTs)),
- proceed;
- {OtherUserTTSup,OtherStartTime} ->
- case OtherStartTime - StartTime of
- Diff when Diff >= 0 ->
- ignore;
- _ ->
- exit(OtherUserTTSup, kill),
- put(test_server_user_timetrap,
- proplists:delete(TCPid, UserTTs)),
- proceed
- end;
- undefined ->
- proceed
- end
- end.
-
-remove_user_timetrap(TTSup) ->
- exit(TTSup, kill).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap_cancel(Handle) -> ok
-%% Handle = term()
-%%
-%% Cancels a time trap.
-timetrap_cancel(Handle) ->
- timetrap_cancel_one(Handle, true).
-
-timetrap_cancel_one(infinity, _SendToServer) ->
- ok;
-timetrap_cancel_one(Handle, SendToServer) ->
- case get(test_server_timetraps) of
- undefined ->
- ok;
- [{Handle,_,_}] ->
- erase(test_server_timetraps);
- Timers ->
- case lists:keysearch(Handle, 1, Timers) of
- {value,_} ->
- put(test_server_timetraps,
- lists:keydelete(Handle, 1, Timers));
- false when SendToServer == true ->
- group_leader() ! {timetrap_cancel_one,Handle,self()};
- false ->
- ok
- end
- end,
- test_server_sup:timetrap_cancel(Handle).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap_cancel() -> ok
-%%
-%% Cancels timetrap for current test case.
-timetrap_cancel() ->
- timetrap_cancel_all(self(), true).
-
-timetrap_cancel_all(TCPid, SendToServer) ->
- case get(test_server_timetraps) of
- undefined ->
- ok;
- Timers ->
- [timetrap_cancel_one(Handle, false) ||
- {Handle,Pid,_} <- Timers, Pid == TCPid]
- end,
- case get(test_server_user_timetrap) of
- undefined ->
- ok;
- UserTTs ->
- case proplists:get_value(TCPid, UserTTs) of
- {UserTTSup,_StartTime} ->
- remove_user_timetrap(UserTTSup),
- put(test_server_user_timetrap,
- proplists:delete(TCPid, UserTTs));
- undefined ->
- ok
- end
- end,
- if SendToServer == true ->
- group_leader() ! {timetrap_cancel_all,TCPid,self()};
- true ->
- ok
- end,
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_timetrap_info() -> {Timeout,Scale} | undefined
-%%
-%% Read timetrap info for current test case
-get_timetrap_info() ->
- get_timetrap_info(self(), true).
-
-get_timetrap_info(TCPid, SendToServer) ->
- case get(test_server_timetraps) of
- undefined ->
- undefined;
- Timers ->
- case [Info || {Handle,Pid,Info} <- Timers,
- Pid == TCPid, Handle /= infinity] of
- [I|_] ->
- I;
- [] when SendToServer == true ->
- tc_supervisor_req({get_timetrap_info,TCPid});
- [] ->
- undefined
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% hours(N) -> Milliseconds
-%% minutes(N) -> Milliseconds
-%% seconds(N) -> Milliseconds
-%% N = integer() | float()
-%% Milliseconds = integer()
-%%
-%% Transforms the named units to milliseconds. Fractions in the input
-%% are accepted. The output is an integer.
-hours(N) -> trunc(N * 1000 * 60 * 60).
-minutes(N) -> trunc(N * 1000 * 60).
-seconds(N) -> trunc(N * 1000).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% tc_supervisor_req(Tag) -> Result
-%% tc_supervisor_req(Tag, Msg) -> Result
-%%
-
-tc_supervisor_req(Tag) ->
- Pid = test_server_gl:get_tc_supervisor(group_leader()),
- Pid ! {Tag,self()},
- receive
- {Pid,Tag,Result} ->
- Result
- after 5000 ->
- error(no_answer_from_tc_supervisor)
- end.
-
-tc_supervisor_req(Tag, Msg) ->
- Pid = test_server_gl:get_tc_supervisor(group_leader()),
- Pid ! {Tag,self(),Msg},
- receive
- {Pid,Tag,Result} ->
- Result
- after 5000 ->
- error(no_answer_from_tc_supervisor)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timecall(M,F,A) -> {Time,Val}
-%% Time = float()
-%%
-%% Measures the time spent evaluating MFA. The measurement is done with
-%% erlang:now/0, and should have pretty good accuracy on most platforms.
-%% The function is not evaluated in a catch context.
-timecall(M, F, A) ->
- test_server_sup:timecall(M,F,A).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% do_times(N,M,F,A) -> ok
-%% do_times(N,Fun) ->
-%% N = integer()
-%% Fun = fun() -> void()
-%%
-%% Evaluates MFA or Fun N times, and returns ok.
-do_times(N,M,F,A) when N>0 ->
- apply(M,F,A),
- do_times(N-1,M,F,A);
-do_times(0,_,_,_) ->
- ok.
-
-do_times(N,Fun) when N>0 ->
- Fun(),
- do_times(N-1,Fun);
-do_times(0,_) ->
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}})
-%% M = integer()
-%% N = integer()
-%% Fun = fun() -> void()
-%% R = integer()
-%%
-%% Repeats evaluating the given function until it succeeded (didn't crash)
-%% M times. If, after N times, M successful attempts have not been
-%% accomplished, the process crashes with reason {m_out_of_n_failed
-%% {R,left_to_do}}, where R indicates how many cases that remained to be
-%% successfully completed.
-%%
-%% For example:
-%% m_out_of_n(1,4,fun() -> tricky_test_case() end)
-%% Tries to run tricky_test_case() up to 4 times,
-%% and is happy if it succeeds once.
-%%
-%% m_out_of_n(7,8,fun() -> clock_sanity_check() end)
-%% Tries running clock_sanity_check() up to 8
-%% times and allows the function to fail once.
-%% This might be useful if clock_sanity_check/0
-%% is known to fail if the clock crosses an hour
-%% boundary during the test (and the up to 8
-%% test runs could never cross 2 boundaries)
-m_out_of_n(0,_,_) ->
- ok;
-m_out_of_n(M,0,_) ->
- exit({m_out_of_n_failed,{M,left_to_do}});
-m_out_of_n(M,N,Fun) ->
- case catch Fun() of
- {'EXIT',_} ->
- m_out_of_n(M,N-1,Fun);
- _Other ->
- m_out_of_n(M-1,N-1,Fun)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%call_crash(M,F,A)
-%%call_crash(Time,M,F,A)
-%%call_crash(Time,Crash,M,F,A)
-%% M - atom()
-%% F - atom()
-%% A - [term()]
-%% Time - integer() in milliseconds.
-%% Crash - term()
-%%
-%% Spaws a new process that calls MFA. The call is considered
-%% successful if the call crashes with the given reason (Crash),
-%% or any other reason if Crash is not specified.
-%% ** The call must terminate withing the given Time (defaults
-%% to infinity), or it is considered a failure (exit with reason
-%% 'call_crash_timeout' is generated).
-
-call_crash(M,F,A) ->
- call_crash(infinity,M,F,A).
-call_crash(Time,M,F,A) ->
- call_crash(Time,any,M,F,A).
-call_crash(Time,Crash,M,F,A) ->
- test_server_sup:call_crash(Time,Crash,M,F,A).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_node(SlaveName, Type, Options) ->
-%% {ok, Slave} | {error, Reason}
-%%
-%% SlaveName = string(), atom().
-%% Type = slave | peer
-%% Options = [{tuple(), term()}]
-%%
-%% OptionList is a tuplelist wich may contain one
-%% or more of these members:
-%%
-%% Slave and Peer:
-%% {remote, true} - Start the node on a remote host. If not specified,
-%% the node will be started on the local host (with
-%% some exceptions, for instance VxWorks,
-%% where all nodes are started on a remote host).
-%% {args, Arguments} - Arguments passed directly to the node.
-%% {cleanup, false} - Nodes started with this option will not be killed
-%% by the test server after completion of the test case
-%% Therefore it is IMPORTANT that the USER terminates
-%% the node!!
-%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList
-%% when starting nodes, instead of the same emulator
-%% as the test server is running. ReleaseList is a list
-%% of specifiers, where a specifier is either
-%% {release, Rel}, {prog, Prog}, or 'this'. Rel is
-%% either the name of a release, e.g., "r7a" or
-%% 'latest'. 'this' means using the same emulator as
-%% the test server. Prog is the name of an emulator
-%% executable. If the list has more than one element,
-%% one of them is picked randomly. (Only
-%% works on Solaris and Linux, and the test
-%% server gives warnings when it notices that
-%% nodes are not of the same version as
-%% itself.)
-%%
-%% Peer only:
-%% {wait, false} - Don't wait for the node to be started.
-%% {fail_on_error, false} - Returns {error, Reason} rather than failing
-%% the test case. This option can only be used with
-%% peer nodes.
-%% Note that slave nodes always act as if they had
-%% fail_on_error==false.
-%%
-
-start_node(Name, Type, Options) ->
- lists:foreach(
- fun(N) ->
- case firstname(N) of
- Name ->
- format("=== WARNING: Trying to start node \'~w\' when node"
- " with same first name exists: ~w", [Name, N]);
- _other -> ok
- end
- end,
- nodes()),
-
- group_leader() ! {sync_apply,
- self(),
- {test_server_ctrl,start_node,[Name,Type,Options]}},
- Result = receive {sync_result,R} -> R end,
-
- case Result of
- {ok,Node} ->
-
- %% Cannot run cover on shielded node or on a node started
- %% by a shielded node.
- Cover = case is_cover(Node) of
- true ->
- proplists:get_value(start_cover,Options,true);
- false ->
- false
- end,
-
- net_adm:ping(Node),
- case Cover of
- true ->
- do_cover_for_node(Node,start);
- _ ->
- ok
- end,
- {ok,Node};
- {fail,Reason} -> fail(Reason);
- Error -> Error
- end.
-
-firstname(N) ->
- list_to_atom(upto($@,atom_to_list(N))).
-
-%% This should!!! crash if H is not member in list.
-upto(H, [H | _T]) -> [];
-upto(H, [X | T]) -> [X | upto(H,T)].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% wait_for_node(Name) -> ok | {error,timeout}
-%%
-%% If a node is started with the options {wait,false}, this function
-%% can be used to wait for the node to come up from the
-%% test server point of view (i.e. wait until it has contacted
-%% the test server controller after startup)
-wait_for_node(Slave) ->
- group_leader() ! {sync_apply,
- self(),
- {test_server_ctrl,wait_for_node,[Slave]}},
- Result = receive {sync_result,R} -> R end,
- case Result of
- ok ->
- net_adm:ping(Slave),
- case is_cover(Slave) of
- true ->
- do_cover_for_node(Slave,start);
- _ ->
- ok
- end;
- _ ->
- ok
- end,
- Result.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% stop_node(Name) -> true|false
-%%
-%% Kills a (remote) node.
-%% Also inform test_server_ctrl so it can clean up!
-stop_node(Slave) ->
- Cover = is_cover(Slave),
- if Cover -> do_cover_for_node(Slave,flush,false);
- true -> ok
- end,
- group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}},
- Result = receive {sync_result,R} -> R end,
- case Result of
- ok ->
- erlang:monitor_node(Slave, true),
- slave:stop(Slave),
- receive
- {nodedown, Slave} ->
- format(minor, "Stopped slave node: ~w", [Slave]),
- format(major, "=node_stop ~w", [Slave]),
- if Cover -> do_cover_for_node(Slave,stop,false);
- true -> ok
- end,
- true
- after 30000 ->
- format("=== WARNING: Node ~w does not seem to terminate.",
- [Slave]),
- erlang:monitor_node(Slave, false),
- receive {nodedown, Slave} -> ok after 0 -> ok end,
- false
- end;
- {error, _Reason} ->
- %% Either, the node is already dead or it was started
- %% with the {cleanup,false} option, or it was started
- %% in some other way than test_server:start_node/3
- format("=== WARNING: Attempt to stop a nonexisting slavenode (~w)~n"
- "=== Trying to kill it anyway!!!",
- [Slave]),
- case net_adm:ping(Slave)of
- pong ->
- erlang:monitor_node(Slave, true),
- slave:stop(Slave),
- receive
- {nodedown, Slave} ->
- format(minor, "Stopped slave node: ~w", [Slave]),
- format(major, "=node_stop ~w", [Slave]),
- if Cover -> do_cover_for_node(Slave,stop,false);
- true -> ok
- end,
- true
- after 30000 ->
- format("=== WARNING: Node ~w does not seem to terminate.",
- [Slave]),
- erlang:monitor_node(Slave, false),
- receive {nodedown, Slave} -> ok after 0 -> ok end,
- false
- end;
- pang ->
- if Cover -> do_cover_for_node(Slave,stop,false);
- true -> ok
- end,
- false
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_release_available(Release) -> true | false
-%% Release -> string()
-%%
-%% Test if a release (such as "r10b") is available to be
-%% started using start_node/3.
-
-is_release_available(Release) ->
- group_leader() ! {sync_apply,
- self(),
- {test_server_ctrl,is_release_available,[Release]}},
- receive {sync_result,R} -> R end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_on_shielded_node(Fun, CArgs) -> term()
-%% Fun -> function()
-%% CArg -> list()
-%%
-%%
-%% Fun is executed in a process on a temporarily created
-%% hidden node. Communication with the job process goes
-%% via a job proxy process on the hidden node, i.e. the
-%% group leader of the test case process is the job proxy
-%% process. This makes it possible to start nodes from the
-%% hidden node that are unaware of the test server node.
-%% Without the job proxy process all processes would have
-%% a process residing on the test_server node as group_leader.
-%%
-%% Fun - Function to execute
-%% CArg - Extra command line arguments to use when starting
-%% the shielded node.
-%%
-%% If Fun is successfully executed, the result is returned.
-%%
-
-run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) ->
- Nr = erlang:unique_integer([positive]),
- Name = "shielded_node-" ++ integer_to_list(Nr),
- Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of
- {ok, N} -> N;
- Err -> fail({failed_to_start_shielded_node, Err})
- end,
- Master = self(),
- Ref = make_ref(),
- Slave = spawn(Node,
- fun () ->
- start_job_proxy(),
- receive
- Ref ->
- Master ! {Ref, Fun()}
- end,
- receive after infinity -> infinity end
- end),
- MRef = erlang:monitor(process, Slave),
- Slave ! Ref,
- receive
- {'DOWN', MRef, _, _, Info} ->
- stop_node(Node),
- fail(Info);
- {Ref, Res} ->
- stop_node(Node),
- receive
- {'DOWN', MRef, _, _, _} ->
- Res
- end
- end.
-
-%% Return true if Name or node() is a shielded node
-is_shielded(Name) ->
- case {cast_to_list(Name),atom_to_list(node())} of
- {"shielded_node"++_,_} -> true;
- {_,"shielded_node"++_} -> true;
- _ -> false
- end.
-
-same_version(Name) ->
- ThisVersion = erlang:system_info(version),
- OtherVersion = rpc:call(Name, erlang, system_info, [version]),
- ThisVersion =:= OtherVersion.
-
-is_cover(Name) ->
- case is_cover() of
- true ->
- not is_shielded(Name) andalso same_version(Name);
- false ->
- false
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% temp_name(Stem) -> string()
-%% Stem = string()
-%%
-%% Create a unique file name, based on (starting with) Stem.
-%% A filename of the form <Stem><Number> is generated, and the
-%% function checks that that file doesn't already exist.
-temp_name(Stem) ->
- Num = erlang:unique_integer([positive]),
- RandomName = Stem ++ integer_to_list(Num),
- {ok,Files} = file:list_dir(filename:dirname(Stem)),
- case lists:member(RandomName,Files) of
- true ->
- %% oh, already exists - bad luck. Try again.
- temp_name(Stem); %% recursively try again
- false ->
- RandomName
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% app_test/1
-%%
-app_test(App) ->
- app_test(App, pedantic).
-app_test(App, Mode) ->
- test_server_sup:app_test(App, Mode).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% appup_test/1
-%%
-appup_test(App) ->
- test_server_sup:appup_test(App).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_native(Mod) -> true | false
-%%
-%% Checks wether the module is natively compiled or not.
-
-is_native(Mod) ->
- (catch Mod:module_info(native)) =:= true.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% comment(String) -> ok
-%%
-%% The given String will occur in the comment field
-%% of the table on the test suite result page. If
-%% called several times, only the last comment is
-%% printed.
-%% comment/1 is also overwritten by the return value
-%% {comment,Comment} or fail/1 (which prints Reason
-%% as a comment).
-comment(String) ->
- group_leader() ! {comment,String},
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% read_comment() -> string()
-%%
-%% Read the current comment string stored in
-%% state during test case execution.
-read_comment() ->
- tc_supervisor_req(read_comment).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% make_priv_dir() -> ok
-%%
-%% Order test server to create the private directory
-%% for the current test case.
-make_priv_dir() ->
- tc_supervisor_req(make_priv_dir).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% os_type() -> OsType
-%%
-%% Returns the OsType of the target node. OsType is
-%% the same as returned from os:type()
-os_type() ->
- os:type().
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_cover() -> boolean()
-%%
-%% Returns true if cover is running, else false
-is_cover() ->
- case whereis(cover_server) of
- undefined -> false;
- _ -> true
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_debug() -> boolean()
-%%
-%% Returns true if the emulator is debug-compiled, false otherwise.
-is_debug() ->
- case catch erlang:system_info(debug_compiled) of
- {'EXIT', _} ->
- case string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 -> true;
- _ -> false
- end;
- Res ->
- Res
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% has_lock_checking() -> boolean()
-%%
-%% Returns true if the emulator has lock checking enabled, false otherwise.
-has_lock_checking() ->
- case catch erlang:system_info(lock_checking) of
- {'EXIT', _} -> false;
- Res -> Res
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% has_superfluous_schedulers() -> boolean()
-%%
-%% Returns true if the emulator has more scheduler threads than logical
-%% processors, false otherwise.
-has_superfluous_schedulers() ->
- case catch {erlang:system_info(schedulers),
- erlang:system_info(logical_processors)} of
- {S, P} when is_integer(S), is_integer(P), S > P -> true;
- _ -> false
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_commercial_build() -> boolean()
-%%
-%% Returns true if the current emulator is commercially supported.
-%% (The emulator will not have "[source]" in its start-up message.)
-%% We might want to do more tests on a commercial platform, for instance
-%% ensuring that all applications have documentation).
-is_commercial() ->
- case string:str(erlang:system_info(system_version), "source") of
- Int when is_integer(Int), Int > 0 -> false;
- _ -> true
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% DEBUGGER INTERFACE %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% purify_is_running() -> false|true
-%%
-%% Tests if Purify is currently running.
-
-purify_is_running() ->
- case catch erlang:system_info({error_checker, running}) of
- {'EXIT', _} -> false;
- Res -> Res
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% purify_new_leaks() -> false|BytesLeaked
-%% BytesLeaked = integer()
-%%
-%% Checks for new memory leaks if Purify is active.
-%% Returns the number of bytes leaked, or false if Purify
-%% is not running.
-purify_new_leaks() ->
- case catch erlang:system_info({error_checker, memory}) of
- {'EXIT', _} -> false;
- Leaked when is_integer(Leaked) -> Leaked
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% purify_new_fds_inuse() -> false|FdsInuse
-%% FdsInuse = integer()
-%%
-%% Checks for new file descriptors in use.
-%% Returns the number of new file descriptors in use, or false
-%% if Purify is not running.
-purify_new_fds_inuse() ->
- case catch erlang:system_info({error_checker, fd}) of
- {'EXIT', _} -> false;
- Inuse when is_integer(Inuse) -> Inuse
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% purify_format(Format, Args) -> ok
-%% Format = string()
-%% Args = lists()
-%%
-%% Outputs the formatted string to Purify's logfile,if Purify is active.
-purify_format(Format, Args) ->
- (catch erlang:system_info({error_checker, io_lib:format(Format, Args)})),
- ok.
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Apply given function and reply to caller or proxy.
-%%
-do_sync_apply(Proxy, From, {M,F,A}) ->
- Result = apply(M, F, A),
- if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result};
- true -> From ! {sync_result,Result}
- end.
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
deleted file mode 100644
index 8a46996bc3..0000000000
--- a/lib/test_server/src/test_server_ctrl.erl
+++ /dev/null
@@ -1,5646 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(test_server_ctrl).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The Erlang Test Server %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% MODULE DEPENDENCIES:
-%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string,
-%% code, ets, rpc, gen_tcp, inet, erl_tar, sets,
-%% test_server, test_server_sup, test_server_node
-%% EASIER TO REMOVE: filename, filelib, lib, re
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([start/0, start/1, start_link/1, stop/0]).
-
-%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([add_spec/1, add_dir/2, add_dir/3]).
--export([add_module/1, add_module/2,
- add_conf/3,
- add_case/2, add_case/3, add_cases/2, add_cases/3]).
--export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]).
--export([add_module_with_skip/2, add_module_with_skip/3,
- add_conf_with_skip/4,
- add_case_with_skip/3, add_case_with_skip/4,
- add_cases_with_skip/3, add_cases_with_skip/4]).
--export([jobs/0, run_test/1, wait_finish/0, idle_notify/1,
- abort_current_testcase/1, abort/0]).
--export([start_get_totals/1, stop_get_totals/0]).
--export([reject_io_reqs/1, get_levels/0, set_levels/3]).
--export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]).
--export([create_priv_dir/1]).
--export([cover/1, cover/2, cover/3,
- cover_compile/7, cover_analyse/2, cross_cover_analyse/2,
- trc/1, stop_trace/0]).
--export([testcase_callback/1]).
--export([set_random_seed/1]).
--export([kill_slavenodes/0]).
-
-%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([print/2, print/3, print/4, print_timestamp/2]).
--export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
--export([format/1, format/2, format/3, to_string/1]).
--export([get_target_info/0]).
--export([get_hosts/0]).
--export([node_started/1]).
--export([uri_encode/1,uri_encode/2]).
-
-%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([i/0, p/1, p/3, pi/2, pi/4, t/0, t/1]).
-
-%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2]).
--export([do_test_cases/4]).
--export([do_spec/2, do_spec_list/2]).
--export([xhtml/2]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--include("test_server_internal.hrl").
--include_lib("kernel/include/file.hrl").
--define(suite_ext, "_SUITE").
--define(log_ext, ".log.html").
--define(src_listing_ext, ".src.html").
--define(logdir_ext, ".logs").
--define(data_dir_suffix, "_data/").
--define(suitelog_name, "suite.log").
--define(coverlog_name, "cover.html").
--define(raw_coverlog_name, "cover.log").
--define(cross_coverlog_name, "cross_cover.html").
--define(raw_cross_coverlog_name, "cross_cover.log").
--define(cross_cover_info, "cross_cover.info").
--define(cover_total, "total_cover.log").
--define(unexpected_io_log, "unexpected_io.log.html").
--define(last_file, "last_name").
--define(last_link, "last_link").
--define(last_test, "last_test").
--define(html_ext, ".html").
--define(now, os:timestamp()).
-
--define(void_fun, fun() -> ok end).
--define(mod_result(X), if X == skip -> skipped;
- X == auto_skip -> skipped;
- true -> X end).
-
--define(auto_skip_color, "#FFA64D").
--define(user_skip_color, "#FF8000").
--define(sortable_table_name, "SortableTable").
-
--record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false,
- multiply_timetraps=1, scale_timetraps=true,
- create_priv_dir=auto_per_run, finish=false,
- target_info, trc=false, cover=false, wait_for_node=[],
- testcase_callback=undefined, idle_notify=[],
- get_totals=false, random_seed=undefined}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% OPERATOR INTERFACE
-
-add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) ->
- add_job(cast_to_list(Name),
- lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job));
-add_dir(Name, Dir) ->
- add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}).
-
-add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) ->
- add_job(cast_to_list(Name),
- lists:map(fun(D)-> {dir,cast_to_list(D),
- cast_to_list(Pattern)} end, Job));
-add_dir(Name, Dir, Pattern) ->
- add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}).
-
-add_module(Mod) when is_atom(Mod) ->
- add_job(atom_to_list(Mod), {Mod,all}).
-
-add_module(Name, Mods) when is_list(Mods) ->
- add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)).
-
-add_conf(Name, Mod, Conf) when is_tuple(Conf) ->
- add_job(cast_to_list(Name), {Mod,[Conf]});
-
-add_conf(Name, Mod, Confs) when is_list(Confs) ->
- add_job(cast_to_list(Name), {Mod,Confs}).
-
-add_case(Mod, Case) when is_atom(Mod), is_atom(Case) ->
- add_job(atom_to_list(Mod), {Mod,Case}).
-
-add_case(Name, Mod, Case) when is_atom(Mod), is_atom(Case) ->
- add_job(Name, {Mod,Case}).
-
-add_cases(Mod, Cases) when is_atom(Mod), is_list(Cases) ->
- add_job(atom_to_list(Mod), {Mod,Cases}).
-
-add_cases(Name, Mod, Cases) when is_atom(Mod), is_list(Cases) ->
- add_job(Name, {Mod,Cases}).
-
-add_spec(Spec) ->
- Name = filename:rootname(Spec, ".spec"),
- case filelib:is_file(Spec) of
- true -> add_job(Name, {spec,Spec});
- false -> {error,nofile}
- end.
-
-%% This version of the interface is to be used if there are
-%% suites or cases that should be skipped.
-
-add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) ->
- add_job(cast_to_list(Name),
- lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job),
- Skip);
-add_dir_with_skip(Name, Dir, Skip) ->
- add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip).
-
-add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) ->
- add_job(cast_to_list(Name),
- lists:map(fun(D)-> {dir,cast_to_list(D),
- cast_to_list(Pattern)} end, Job),
- Skip);
-add_dir_with_skip(Name, Dir, Pattern, Skip) ->
- add_job(cast_to_list(Name),
- {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip).
-
-add_module_with_skip(Mod, Skip) when is_atom(Mod) ->
- add_job(atom_to_list(Mod), {Mod,all}, Skip).
-
-add_module_with_skip(Name, Mods, Skip) when is_list(Mods) ->
- add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip).
-
-add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) ->
- add_job(cast_to_list(Name), {Mod,[Conf]}, Skip);
-
-add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) ->
- add_job(cast_to_list(Name), {Mod,Confs}, Skip).
-
-add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
- add_job(atom_to_list(Mod), {Mod,Case}, Skip).
-
-add_case_with_skip(Name, Mod, Case, Skip) when is_atom(Mod), is_atom(Case) ->
- add_job(Name, {Mod,Case}, Skip).
-
-add_cases_with_skip(Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
- add_job(atom_to_list(Mod), {Mod,Cases}, Skip).
-
-add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) ->
- add_job(Name, {Mod,Cases}, Skip).
-
-add_tests_with_skip(LogDir, Tests, Skip) ->
- add_job(LogDir,
- lists:map(fun({Dir,all,all}) ->
- {Dir,{dir,Dir}};
- ({Dir,Mods,all}) ->
- {Dir,lists:map(fun(M) -> {M,all} end, Mods)};
- ({Dir,Mod,Cases}) ->
- {Dir,{Mod,Cases}}
- end, Tests),
- Skip).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% COMMAND LINE INTERFACE
-
-parse_cmd_line(Cmds) ->
- parse_cmd_line(Cmds, [], [], local, false, false, undefined).
-
-parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- case file:consult(Spec) of
- {ok, TermList} ->
- Name = filename:rootname(Spec),
- parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param,
- Trc, Cov, TCCB);
- {error,Reason} ->
- io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]),
- parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB)
- end;
-parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds, SpecList, [{name,atom_to_list(Name)}|Names],
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['SKIPMOD',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds, [{skip,{Mod,"by command line"}}|SpecList], Names,
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['SKIPCASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds, [{skip,{Mod,Case,"by command line"}}|SpecList], Names,
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['DIR',Dir|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- Name = filename:basename(Dir),
- parse_cmd_line(Cmds, [{topcase,{dir,Name}}|SpecList], [Name|Names],
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['MODULE',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds,[{topcase,{Mod,all}}|SpecList],[atom_to_list(Mod)|Names],
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['CASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds,[{topcase,{Mod,Case}}|SpecList],[atom_to_list(Mod)|Names],
- Param, Trc, Cov, TCCB);
-parse_cmd_line(['TRACE',Trc|Cmds], SpecList, Names, Param, _Trc, Cov, TCCB) ->
- parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB);
-parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov, TCCB) ->
- parse_cmd_line(Cmds, SpecList, Names, Param, Trc, {{App,CF}, Analyse}, TCCB);
-parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) ->
- parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func});
-parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) ->
- io:format("~w: Bad argument: ~w\n", [?MODULE,Obj]),
- io:format(" Use the `ts' module to start tests.\n", []),
- io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []),
- halt(1);
-parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) ->
- NameList = lists:reverse(Names, ["suite"]),
- Name = case lists:keysearch(name, 1, NameList) of
- {value,{name,N}} -> N;
- false -> hd(NameList)
- end,
- {lists:reverse(SpecList), Name, Param, Trc, Cov, TCCB}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cast_to_list(X) -> string()
-%% X = list() | atom() | void()
-%% Returns a string representation of whatever was input
-
-cast_to_list(X) when is_list(X) -> X;
-cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% START INTERFACE
-
-%% Kept for backwards compatibility
-start(_) ->
- start().
-start_link(_) ->
- start_link().
-
-
-start() ->
- case gen_server:start({local,?MODULE}, ?MODULE, [], []) of
- {ok, Pid} ->
- {ok, Pid};
- Other ->
- Other
- end.
-
-start_link() ->
- case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
- {ok, Pid} ->
- {ok, Pid};
- Other ->
- Other
- end.
-
-run_test(CommandLine) ->
- process_flag(trap_exit,true),
- {SpecList,Name,Param,Trc,Cov,TCCB} = parse_cmd_line(CommandLine),
- {ok,_TSPid} = start_link(Param),
- case Trc of
- false -> ok;
- File -> trc(File)
- end,
- case Cov of
- false -> ok;
- {{App,CoverFile},Analyse} -> cover(App, maybe_file(CoverFile), Analyse)
- end,
- testcase_callback(TCCB),
- add_job(Name, {command_line,SpecList}),
-
- wait_finish().
-
-%% Converted CoverFile to a string unless it is 'none'
-maybe_file(none) ->
- none;
-maybe_file(CoverFile) ->
- atom_to_list(CoverFile).
-
-idle_notify(Fun) ->
- {ok, Pid} = controller_call({idle_notify,Fun}),
- Pid.
-
-start_get_totals(Fun) ->
- {ok, Pid} = controller_call({start_get_totals,Fun}),
- Pid.
-
-stop_get_totals() ->
- ok = controller_call(stop_get_totals),
- ok.
-
-wait_finish() ->
- OldTrap = process_flag(trap_exit, true),
- {ok, Pid} = finish(true),
- link(Pid),
- receive
- {'EXIT',Pid,_} ->
- ok
- end,
- process_flag(trap_exit, OldTrap),
- ok.
-
-abort_current_testcase(Reason) ->
- controller_call({abort_current_testcase,Reason}).
-
-abort() ->
- OldTrap = process_flag(trap_exit, true),
- {ok, Pid} = finish(abort),
- link(Pid),
- receive
- {'EXIT',Pid,_} ->
- ok
- end,
- process_flag(trap_exit, OldTrap),
- ok.
-
-finish(Abort) ->
- controller_call({finish,Abort}).
-
-stop() ->
- controller_call(stop).
-
-jobs() ->
- controller_call(jobs).
-
-get_levels() ->
- controller_call(get_levels).
-
-set_levels(Show, Major, Minor) ->
- controller_call({set_levels,Show,Major,Minor}).
-
-reject_io_reqs(Bool) ->
- controller_call({reject_io_reqs,Bool}).
-
-multiply_timetraps(N) ->
- controller_call({multiply_timetraps,N}).
-
-scale_timetraps(Bool) ->
- controller_call({scale_timetraps,Bool}).
-
-get_timetrap_parameters() ->
- controller_call(get_timetrap_parameters).
-
-create_priv_dir(Value) ->
- controller_call({create_priv_dir,Value}).
-
-trc(TraceFile) ->
- controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT).
-
-stop_trace() ->
- controller_call(stop_trace).
-
-node_started(Node) ->
- gen_server:cast(?MODULE, {node_started,Node}).
-
-cover(App, Analyse) when is_atom(App) ->
- cover(App, none, Analyse);
-cover(CoverFile, Analyse) ->
- cover(none, CoverFile, Analyse).
-cover(App, CoverFile, Analyse) ->
- {Excl,Incl,Cross} = read_cover_file(CoverFile),
- CoverInfo = #cover{app=App,
- file=CoverFile,
- excl=Excl,
- incl=Incl,
- cross=Cross,
- level=Analyse},
- controller_call({cover,CoverInfo}).
-
-cover(CoverInfo) ->
- controller_call({cover,CoverInfo}).
-
-cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) ->
- cover_compile(#cover{app=App,
- file=File,
- excl=Excl,
- incl=Incl,
- cross=Cross,
- level=Analyse,
- stop=Stop}).
-
-testcase_callback(ModFunc) ->
- controller_call({testcase_callback,ModFunc}).
-
-set_random_seed(Seed) ->
- controller_call({set_random_seed,Seed}).
-
-kill_slavenodes() ->
- controller_call(kill_slavenodes).
-
-get_hosts() ->
- get(test_server_hosts).
-
-%%--------------------------------------------------------------------
-
-add_job(Name, TopCase) ->
- add_job(Name, TopCase, []).
-
-add_job(Name, TopCase, Skip) ->
- SuiteName =
- case Name of
- "." -> "current_dir";
- ".." -> "parent_dir";
- Other -> Other
- end,
- Dir = filename:absname(SuiteName),
- controller_call({add_job,Dir,SuiteName,TopCase,Skip}).
-
-controller_call(Arg) ->
- case catch gen_server:call(?MODULE, Arg, infinity) of
- {'EXIT',{{badarg,_},{gen_server,call,_}}} ->
- exit(test_server_ctrl_not_running);
- {'EXIT',Reason} ->
- exit(Reason);
- Other ->
- Other
- end.
-controller_call(Arg, Timeout) ->
- case catch gen_server:call(?MODULE, Arg, Timeout) of
- {'EXIT',{{badarg,_},{gen_server,call,_}}} ->
- exit(test_server_ctrl_not_running);
- {'EXIT',Reason} ->
- exit(Reason);
- Other ->
- Other
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% init([])
-%%
-%% init() is the init function of the test_server's gen_server.
-%%
-init([]) ->
- case os:getenv("TEST_SERVER_CALL_TRACE") of
- false ->
- ok;
- "" ->
- ok;
- TraceSpec ->
- test_server_sup:call_trace(TraceSpec)
- end,
- process_flag(trap_exit, true),
- %% copy format_exception setting from init arg to application environment
- case init:get_argument(test_server_format_exception) of
- {ok,[[TSFE]]} ->
- application:set_env(test_server, format_exception, list_to_atom(TSFE));
- _ ->
- ok
- end,
- test_server_sup:cleanup_crash_dumps(),
- test_server_sup:util_start(),
- State = #state{jobs=[],finish=false},
- TI0 = test_server:init_target_info(),
- TargetHost = test_server_sup:hoststr(),
- TI = TI0#target_info{host=TargetHost,
- naming=naming(),
- master=TargetHost},
- ets:new(slave_tab, [named_table,set,public,{keypos,2}]),
- set_hosts([TI#target_info.host]),
- {ok,State#state{target_info=TI}}.
-
-naming() ->
- case lists:member($., test_server_sup:hoststr()) of
- true -> "-name";
- false -> "-sname"
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(kill_slavenodes, From, State) -> ok
-%%
-%% Kill all slave nodes that remain after a test case
-%% is completed.
-%%
-handle_call(kill_slavenodes, _From, State) ->
- Nodes = test_server_node:kill_nodes(),
- {reply, Nodes, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({set_hosts, HostList}, From, State) -> ok
-%%
-%% Set the global hostlist.
-%%
-handle_call({set_hosts, Hosts}, _From, State) ->
- set_hosts(Hosts),
- {reply, ok, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(get_hosts, From, State) -> [Hosts]
-%%
-%% Returns the lists of hosts that the test server
-%% can use for slave nodes. This is primarily used
-%% for nodename generation.
-%%
-handle_call(get_hosts, _From, State) ->
- Hosts = get_hosts(),
- {reply, Hosts, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) ->
-%% ok | {error,Reason}
-%%
-%% Dir = string()
-%% Name = string()
-%% TopCase = term()
-%% Skip = [SkipItem]
-%% SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}
-%% Mod = Case = atom()
-%% Comment = string()
-%% Cases = [Case]
-%%
-%% Adds a job to the job queue. The name of the job is Name. A log directory
-%% will be created in Dir/Name.logs. TopCase may be anything that
-%% collect_cases/3 accepts, plus the following:
-%%
-%% {spec,SpecName} executes the named test suite specification file. Commands
-%% in the file should be in the format accepted by do_spec_list/1.
-%%
-%% {command_line,SpecList} executes the list of specification instructions
-%% supplied, which should be in the format accepted by do_spec_list/1.
-
-handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
- LogDir = Dir ++ ?logdir_ext,
- ExtraTools =
- case State#state.cover of
- false -> [];
- CoverInfo -> [{cover,CoverInfo}]
- end,
- ExtraTools1 =
- case State#state.random_seed of
- undefined -> ExtraTools;
- Seed -> [{random_seed,Seed}|ExtraTools]
- end,
- case lists:keysearch(Name, 1, State#state.jobs) of
- false ->
- case TopCase of
- {spec,SpecName} ->
- Pid = spawn_tester(
- ?MODULE, do_spec,
- [SpecName,{State#state.multiply_timetraps,
- State#state.scale_timetraps}],
- LogDir, Name, State#state.levels,
- State#state.reject_io_reqs,
- State#state.create_priv_dir,
- State#state.testcase_callback, ExtraTools1),
- NewJobs = [{Name,Pid}|State#state.jobs],
- {reply, ok, State#state{jobs=NewJobs}};
- {command_line,SpecList} ->
- Pid = spawn_tester(
- ?MODULE, do_spec_list,
- [SpecList,{State#state.multiply_timetraps,
- State#state.scale_timetraps}],
- LogDir, Name, State#state.levels,
- State#state.reject_io_reqs,
- State#state.create_priv_dir,
- State#state.testcase_callback, ExtraTools1),
- NewJobs = [{Name,Pid}|State#state.jobs],
- {reply, ok, State#state{jobs=NewJobs}};
- TopCase ->
- case State#state.get_totals of
- {CliPid,Fun} ->
- Result = count_test_cases(TopCase, Skip),
- Fun(CliPid, Result),
- {reply, ok, State};
- _ ->
- Cfg = make_config([]),
- Pid = spawn_tester(
- ?MODULE, do_test_cases,
- [TopCase,Skip,Cfg,
- {State#state.multiply_timetraps,
- State#state.scale_timetraps}],
- LogDir, Name, State#state.levels,
- State#state.reject_io_reqs,
- State#state.create_priv_dir,
- State#state.testcase_callback, ExtraTools1),
- NewJobs = [{Name,Pid}|State#state.jobs],
- {reply, ok, State#state{jobs=NewJobs}}
- end
- end;
- _ ->
- {reply,{error,name_already_in_use},State}
- end;
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(jobs, _, State) -> JobList
-%% JobList = [{Name,Pid}, ...]
-%% Name = string()
-%% Pid = pid()
-%%
-%% Return the list of current jobs.
-
-handle_call(jobs, _From, State) ->
- {reply,State#state.jobs,State};
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({abort_current_testcase,Reason}, _, State) -> Result
-%% Reason = term()
-%% Result = ok | {error,no_testcase_running}
-%%
-%% Attempts to abort the test case that's currently running.
-
-handle_call({abort_current_testcase,Reason}, _From, State) ->
- case State#state.jobs of
- [{_,Pid}|_] ->
- Pid ! {abort_current_testcase,Reason,self()},
- receive
- {Pid,abort_current_testcase,Result} ->
- {reply, Result, State}
- after 10000 ->
- {reply, {error,no_testcase_running}, State}
- end;
- _ ->
- {reply, {error,no_testcase_running}, State}
- end;
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({finish,Fini}, _, State) -> {ok,Pid}
-%% Fini = true | abort
-%%
-%% Tells the test_server to stop as soon as there are no test suites
-%% running. Immediately if none are running. Abort is handled as soon
-%% as current test finishes.
-
-handle_call({finish,Fini}, _From, State) ->
- case State#state.jobs of
- [] ->
- lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end,
- State#state.idle_notify),
- State2 = State#state{finish=false},
- {stop,shutdown,{ok,self()}, State2};
- _SomeJobs ->
- State2 = State#state{finish=Fini},
- {reply, {ok,self()}, State2}
- end;
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({idle_notify,Fun}, From, State) -> {ok,Pid}
-%%
-%% Lets a test client subscribe to receive a notification when the
-%% test server becomes idle (can be used to syncronize jobs).
-%% test_server calls Fun(From) when idle.
-
-handle_call({idle_notify,Fun}, {Cli,_Ref}, State) ->
- case State#state.jobs of
- [] -> self() ! report_idle;
- _ -> ok
- end,
- Subscribed = State#state.idle_notify,
- {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(start_get_totals, From, State) -> {ok,Pid}
-%%
-%% Switch on the mode where the test server will only
-%% report back the number of tests it would execute
-%% given some subsequent jobs.
-
-handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) ->
- {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(stop_get_totals, From, State) -> ok
-%%
-%% Lets a test client subscribe to receive a notification when the
-%% test server becomes idle (can be used to syncronize jobs).
-%% test_server calls Fun(From) when idle.
-
-handle_call(stop_get_totals, {_Cli,_Ref}, State) ->
- {reply, ok, State#state{get_totals=false}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(get_levels, _, State) -> {Show,Major,Minor}
-%% Show = integer()
-%% Major = integer()
-%% Minor = integer()
-%%
-%% Returns a 3-tuple with the logging thresholds.
-%% All output and information from a test suite is tagged with a detail
-%% level. Lower values are more "important". Text that is output using
-%% io:format or similar is automatically tagged with detail level 50.
-%%
-%% All output with detail level:
-%% less or equal to Show is displayed on the screen (default 1)
-%% less or equal to Major is logged in the major log file (default 19)
-%% greater or equal to Minor is logged in the minor log files (default 10)
-
-handle_call(get_levels, _From, State) ->
- {reply,State#state.levels,State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({set_levels,Show,Major,Minor}, _, State) -> ok
-%% Show = integer()
-%% Major = integer()
-%% Minor = integer()
-%%
-%% Sets the logging thresholds, see handle_call(get_levels,...) above.
-
-handle_call({set_levels,Show,Major,Minor}, _From, State) ->
- {reply,ok,State#state{levels={Show,Major,Minor}}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({reject_io_reqs,Bool}, _, State) -> ok
-%% Bool = bool()
-%%
-%% May be used to switch off stdout printouts to the minor log file
-
-handle_call({reject_io_reqs,Bool}, _From, State) ->
- {reply,ok,State#state{reject_io_reqs=Bool}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({multiply_timetraps,N}, _, State) -> ok
-%% N = integer() | infinity
-%%
-%% Multiplies all timetraps set by test cases with N
-
-handle_call({multiply_timetraps,N}, _From, State) ->
- {reply,ok,State#state{multiply_timetraps=N}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({scale_timetraps,Bool}, _, State) -> ok
-%% Bool = true | false
-%%
-%% Specifies if test_server should scale the timetrap value
-%% automatically if e.g. cover is running.
-
-handle_call({scale_timetraps,Bool}, _From, State) ->
- {reply,ok,State#state{scale_timetraps=Bool}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale}
-%% Multiplier = integer() | infinity
-%% Scale = true | false
-%%
-%% Returns the parameter values that affect timetraps.
-
-handle_call(get_timetrap_parameters, _From, State) ->
- {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason}
-%%
-%% Starts a separate node (trace control node) which
-%% starts tracing on target and all slave nodes
-%%
-%% TraceFile is a text file with elements of type
-%% {Trace,Mod,TracePattern}.
-%% {Trace,Mod,Func,TracePattern}.
-%% {Trace,Mod,Func,Arity,TracePattern}.
-%%
-%% Trace = tp | tpl; local or global call trace
-%% Mod,Func = atom(), Arity=integer(); defines what to trace
-%% TracePattern = [] | match_spec()
-%%
-%% The 'call' trace flag is set on all processes, and then
-%% the given trace patterns are set.
-
-handle_call({trace,TraceFile}, _From, State=#state{trc=false}) ->
- TI = State#state.target_info,
- case test_server_node:start_tracer_node(TraceFile, TI) of
- {ok,Tracer} -> {reply,ok,State#state{trc=Tracer}};
- Error -> {reply,Error,State}
- end;
-handle_call({trace,_TraceFile}, _From, State) ->
- {reply,{error,already_tracing},State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(stop_trace, _, State) -> ok | {error,Reason}
-%%
-%% Stops tracing on target and all slave nodes and
-%% terminates trace control node
-
-handle_call(stop_trace, _From, State=#state{trc=false}) ->
- {reply,{error,not_tracing},State};
-handle_call(stop_trace, _From, State) ->
- R = test_server_node:stop_tracer_node(State#state.trc),
- {reply,R,State#state{trc=false}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason}
-%%
-%% Set specification of cover analysis to be used when running tests
-%% (see start_extra_tools/1 and stop_extra_tools/1)
-
-handle_call({cover,CoverInfo}, _From, State) ->
- {reply,ok,State#state{cover=CoverInfo}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
-%%
-%% Set create_priv_dir to either auto_per_run (create common priv dir once
-%% per test run), manual_per_tc (the priv dir name will be unique for each
-%% test case, but the user has to call test_server:make_priv_dir/0 to create
-%% it), or auto_per_tc (unique priv dir created automatically for each test
-%% case).
-
-handle_call({create_priv_dir,Value}, _From, State) ->
- {reply,ok,State#state{create_priv_dir=Value}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason}
-%%
-%% Add a callback function that will be called before and after every
-%% test case (on the test case process):
-%%
-%% Mod:Func(Suite,TestCase,InitOrEnd,Config)
-%%
-%% InitOrEnd = init | 'end'.
-
-handle_call({testcase_callback,ModFunc}, _From, State) ->
- case ModFunc of
- {Mod,Func} ->
- case code:is_loaded(Mod) of
- {file,_} ->
- ok;
- false ->
- code:load_file(Mod)
- end,
- case erlang:function_exported(Mod,Func,4) of
- true ->
- ok;
- false ->
- io:format(user,
- "WARNING! Callback function ~w:~w/4 undefined.~n~n",
- [Mod,Func])
- end;
- _ ->
- ok
- end,
- {reply,ok,State#state{testcase_callback=ModFunc}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({set_random_seed,Seed}, _, State) -> ok | {error,Reason}
-%%
-%% Let operator set a random seed value to be used e.g. for shuffling
-%% test cases.
-
-handle_call({set_random_seed,Seed}, _From, State) ->
- {reply,ok,State#state{random_seed=Seed}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(stop, _, State) -> ok
-%%
-%% Stops the test server immediately.
-%% Some cleanup is done by terminate/2
-
-handle_call(stop, _From, State) ->
- {stop, shutdown, ok, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call(get_target_info, _, State) -> TI
-%%
-%% TI = #target_info{}
-%%
-%% Returns information about target
-
-handle_call(get_target_info, _From, State) ->
- {reply, State#state.target_info, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({start_node,Name,Type,Options}, _, State) ->
-%% ok | {error,Reason}
-%%
-%% Starts a new node (slave or peer)
-
-handle_call({start_node, Name, Type, Options}, From, State) ->
- %% test_server_ctrl does gen_server:reply/2 explicitly
- test_server_node:start_node(Name, Type, Options, From,
- State#state.target_info),
- {noreply,State};
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({wait_for_node,Node}, _, State) -> ok
-%%
-%% Waits for a new node to take contact. Used if
-%% node is started with option {wait,false}
-
-handle_call({wait_for_node, Node}, From, State) ->
- NewWaitList =
- case ets:lookup(slave_tab,Node) of
- [] ->
- [{Node,From}|State#state.wait_for_node];
- _ ->
- gen_server:reply(From,ok),
- State#state.wait_for_node
- end,
- {noreply,State#state{wait_for_node=NewWaitList}};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({stop_node,Name}, _, State) -> ok | {error,Reason}
-%%
-%% Stops a slave or peer node. This is actually only some cleanup
-%% - the node is really stopped by test_server when this returns.
-
-handle_call({stop_node, Name}, _From, State) ->
- R = test_server_node:stop_node(Name),
- {reply, R, State};
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({is_release_available,Name}, _, State) -> ok | {error,Reason}
-%%
-%% Tests if the release is available.
-
-handle_call({is_release_available, Release}, _From, State) ->
- R = test_server_node:is_release_available(Release),
- {reply, R, State}.
-
-%%--------------------------------------------------------------------
-set_hosts(Hosts) ->
- put(test_server_hosts, Hosts).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_cast({node_started,Name}, _, State)
-%%
-%% Called by test_server_node when a slave/peer node is fully started.
-
-handle_cast({node_started,Node}, State) ->
- case State#state.trc of
- false -> ok;
- Trc -> test_server_node:trace_nodes(Trc, [Node])
- end,
- NewWaitList =
- case lists:keysearch(Node,1,State#state.wait_for_node) of
- {value,{Node,From}} ->
- gen_server:reply(From, ok),
- lists:keydelete(Node, 1, State#state.wait_for_node);
- false ->
- State#state.wait_for_node
- end,
- {noreply, State#state{wait_for_node=NewWaitList}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_info({'EXIT',Pid,Reason}, State)
-%% Pid = pid()
-%% Reason = term()
-%%
-%% Handles exit messages from linked processes. Only test suites are
-%% expected to be linked. When a test suite terminates, it is removed
-%% from the job queue.
-
-handle_info(report_idle, State) ->
- Finish = State#state.finish,
- lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
- State#state.idle_notify),
- {noreply,State#state{idle_notify=[]}};
-
-
-handle_info({'EXIT',Pid,Reason}, State) ->
- case lists:keysearch(Pid,2,State#state.jobs) of
- false ->
- %% not our problem
- {noreply,State};
- {value,{Name,_}} ->
- NewJobs = lists:keydelete(Pid, 2, State#state.jobs),
- case Reason of
- normal ->
- fine;
- killed ->
- io:format("Suite ~ts was killed\n", [Name]);
- _Other ->
- io:format("Suite ~ts was killed with reason ~p\n",
- [Name,Reason])
- end,
- State2 = State#state{jobs=NewJobs},
- Finish = State2#state.finish,
- case NewJobs of
- [] ->
- lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
- State2#state.idle_notify),
- case Finish of
- false ->
- {noreply,State2#state{idle_notify=[]}};
- _ -> % true | abort
- %% test_server:finish() has been called and
- %% there are no jobs in the job queue =>
- %% stop the test_server_ctrl
- {stop,shutdown,State2#state{finish=false}}
- end;
- _ -> % pending jobs
- case Finish of
- abort -> % abort test now!
- lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end,
- State2#state.idle_notify),
- {stop,shutdown,State2#state{finish=false}};
- _ -> % true | false
- {noreply, State2}
- end
- end
- end;
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_info({tcp_closed,Sock}, State)
-%%
-%% A Socket was closed. This indicates that a node died.
-%% This can be
-%% *Slave or peer node started by a test suite
-%% *Trace controll node
-
-handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) ->
- %% Tracer node died - can't really do anything
- %%! Maybe print something???
- {noreply,State#state{trc=false}};
-handle_info({tcp_closed,Sock}, State) ->
- test_server_node:nodedown(Sock),
- {noreply,State};
-handle_info(_, State) ->
- %% dummy; accept all, do nothing.
- {noreply, State}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% terminate(Reason, State) -> ok
-%% Reason = term()
-%%
-%% Cleans up when the test_server is terminating. Kills the running
-%% test suites (if any) and any possible remainting slave node
-
-terminate(_Reason, State) ->
- test_server_sup:util_stop(),
- case State#state.trc of
- false -> ok;
- Sock -> test_server_node:stop_tracer_node(Sock)
- end,
- kill_all_jobs(State#state.jobs),
- test_server_node:kill_nodes(),
- ok.
-
-kill_all_jobs([{_Name,JobPid}|Jobs]) ->
- exit(JobPid, kill),
- kill_all_jobs(Jobs);
-kill_all_jobs([]) ->
- ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%----------------------- INTERNAL FUNCTIONS -----------------------%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
-%% CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid
-%% Mod = atom()
-%% Func = atom()
-%% Args = [term(),...]
-%% Dir = string()
-%% Name = string()
-%% Levels = {integer(),integer(),integer()}
-%% RejectIoReqs = bool()
-%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc
-%% TestCaseCallback = {CBMod,CBFunc} | undefined
-%% ExtraTools = [ExtraTool,...]
-%% ExtraTool = CoverInfo | TraceInfo | RandomSeed
-%%
-%% Spawns a test suite execute-process, just an ordinary spawn, except
-%% that it will set a lot of dictionary information before starting the
-%% named function. Also, the execution is timed and protected by a catch.
-%% When the named function is done executing, a summary of the results
-%% is printed to the log files.
-
-spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
- CreatePrivDir, TCCallback, ExtraTools) ->
- spawn_link(fun() ->
- init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs,
- CreatePrivDir, TCCallback, ExtraTools)
- end).
-
-init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
- RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) ->
- process_flag(trap_exit, true),
- test_server_io:start_link(),
- put(test_server_name, Name),
- put(test_server_dir, Dir),
- put(test_server_total_time, 0),
- put(test_server_ok, 0),
- put(test_server_failed, 0),
- put(test_server_skipped, {0,0}),
- put(test_server_minor_level, MinLev),
- put(test_server_create_priv_dir, CreatePrivDir),
- put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)),
- put(test_server_testcase_callback, TCCallback),
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" ->
- put(test_server_framework, '$none');
- FW ->
- put(test_server_framework_name, list_to_atom(FW)),
- case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
- FWName when FWName =:= false; FWName =:= "undefined" ->
- put(test_server_framework_name, '$none');
- FWName ->
- put(test_server_framework_name, list_to_atom(FWName))
- end
- end,
-
- %% before first print, read and set logging options
- LogOpts = test_server_sup:framework_call(get_logopts, [], []),
- put(test_server_logopts, LogOpts),
-
- StartedExtraTools = start_extra_tools(ExtraTools),
-
- test_server_io:set_job_name(Name),
- test_server_io:set_gl_props([{levels,Levels},
- {auto_nl,not lists:member(no_nl, LogOpts)},
- {reject_io_reqs,RejectIoReqs}]),
- group_leader(test_server_io:get_gl(true), self()),
- {TimeMy,Result} = ts_tc(Mod, Func, Args),
- set_io_buffering(undefined),
- test_server_io:set_job_name(undefined),
- catch stop_extra_tools(StartedExtraTools),
- case Result of
- {'EXIT',test_suites_done} ->
- ok;
- {'EXIT',_Pid,Reason} ->
- print(1, "EXIT, reason ~p", [Reason]);
- {'EXIT',Reason} ->
- report_severe_error(Reason),
- print(1, "EXIT, reason ~p", [Reason])
- end,
- Time = TimeMy/1000000,
- SuccessStr =
- case get(test_server_failed) of
- 0 -> "Ok";
- _ -> "FAILED"
- end,
- {SkippedN,SkipStr} =
- case get(test_server_skipped) of
- {0,0} ->
- {0,""};
- {USkipped,ASkipped} ->
- Skipped = USkipped+ASkipped,
- {Skipped,io_lib:format(", ~w Skipped", [Skipped])}
- end,
- OkN = get(test_server_ok),
- FailedN = get(test_server_failed),
- print(html,"\n</tbody>\n<tfoot>\n"
- "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>"
- "<td>~.3fs</td><td><b>~ts</b></td><td>~w Ok, ~w Failed~ts of ~w</td></tr>\n"
- "</tfoot>\n",
- [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]),
-
- test_server_io:stop([major,html,unexpected_io]),
- {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer),
- {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]),
- io:put_chars(UnexpectedIoFd, "\n</pre>\n"++UnexpectedIoFooter),
- file:close(UnexpectedIoFd),
- ok.
-
-report_severe_error(Reason) ->
- test_server_sup:framework_call(report, [severe_error,Reason]).
-
-ts_tc(M,F,A) ->
- Before = erlang:monotonic_time(),
- Result = (catch apply(M, F, A)),
- After = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(After-Before,
- native,
- micro_seconds),
- {Elapsed, Result}.
-
-start_extra_tools(ExtraTools) ->
- start_extra_tools(ExtraTools, []).
-start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) ->
- case start_cover(CoverInfo) of
- {ok,NewCoverInfo} ->
- start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]);
- {error,_} ->
- start_extra_tools(ExtraTools, Started)
- end;
-start_extra_tools([_ | ExtraTools], Started) ->
- start_extra_tools(ExtraTools, Started);
-start_extra_tools([], Started) ->
- Started.
-
-stop_extra_tools(ExtraTools) ->
- TestDir = get(test_server_log_dir_base),
- case lists:keymember(cover, 1, ExtraTools) of
- false ->
- write_default_coverlog(TestDir);
- true ->
- ok
- end,
- stop_extra_tools(ExtraTools, TestDir).
-
-stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) ->
- stop_cover(CoverInfo,TestDir),
- stop_extra_tools(ExtraTools, TestDir);
-%%stop_extra_tools([_ | ExtraTools], TestDir) ->
-%% stop_extra_tools(ExtraTools, TestDir);
-stop_extra_tools([], _) ->
- ok.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result)
-%% SpecName = string()
-%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
-%% MultiplyTimetrap = integer() | infinity
-%% ScaleTimetrap = bool()
-%%
-%% Reads the named test suite specification file, and executes it.
-%%
-%% This function is meant to be called by a process created by
-%% spawn_tester/10, which sets up some necessary dictionary values.
-
-do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
- case file:consult(SpecName) of
- {ok,TermList} ->
- do_spec_list(TermList,TimetrapSpec);
- {error,Reason} ->
- io:format("Can't open ~ts: ~p\n", [SpecName,Reason]),
- {error,{cant_open_spec,Reason}}
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% do_spec_list(TermList, TimetrapSpec) -> exit(Result)
-%% TermList = [term()|...]
-%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
-%% MultiplyTimetrap = integer() | infinity
-%% ScaleTimetrap = bool()
-%%
-%% Executes a list of test suite specification commands. The following
-%% commands are available, and may occur zero or more times (if several,
-%% the contents is appended):
-%%
-%% {topcase,TopCase} Specifies top level test goals. TopCase has the syntax
-%% specified by collect_cases/3.
-%%
-%% {skip,Skip} Specifies test cases to skip, and lists requirements that
-%% cannot be granted during the test run. Skip has the syntax specified
-%% by collect_cases/3.
-%%
-%% {nodes,Nodes} Lists node names avaliable to the test suites. Nodes have
-%% the syntax specified by collect_cases/3.
-%%
-%% {require_nodenames, Num} Specifies how many nodenames the test suite will
-%% need. Theese are automaticly generated and inserted into the Config by the
-%% test_server. The caller may specify other hosts to run theese nodes by
-%% using the {hosts, Hosts} option. If there are no hosts specified, all
-%% nodenames will be generated from the local host.
-%%
-%% {hosts, Hosts} Specifies a list of available hosts on which to start
-%% slave nodes. It is used when the {remote, true} option is given to the
-%% test_server:start_node/3 function. Also, if {require_nodenames, Num} is
-%% contained in the TermList, the generated nodenames will be spread over
-%% all hosts given in this Hosts list. The hostnames are given as atoms or
-%% strings.
-%%
-%% {diskless, true}</c></tag> is kept for backwards compatiblilty and
-%% should not be used. Use a configuration test case instead.
-%%
-%% This function is meant to be called by a process created by
-%% spawn_tester/10, which sets up some necessary dictionary values.
-
-do_spec_list(TermList0, TimetrapSpec) ->
- Nodes = [],
- TermList =
- case lists:keysearch(hosts, 1, TermList0) of
- {value, {hosts, Hosts0}} ->
- Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0),
- controller_call({set_hosts, Hosts}),
- lists:keydelete(hosts, 1, TermList0);
- _ ->
- TermList0
- end,
- DefaultConfig = make_config([{nodes,Nodes}]),
- {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig),
- do_test_cases(TopCases, SkipList, Config, TimetrapSpec).
-
-do_spec_terms([], TopCases, SkipList, Config) ->
- {TopCases,SkipList,Config};
-do_spec_terms([{topcase,TopCase}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms,[TopCase|TopCases], SkipList, Config);
-do_spec_terms([{skip,Skip}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms, TopCases, [Skip|SkipList], Config);
-do_spec_terms([{nodes,Nodes}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms, TopCases, SkipList,
- update_config(Config, {nodes,Nodes}));
-do_spec_terms([{diskless,How}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms, TopCases, SkipList,
- update_config(Config, {diskless,How}));
-do_spec_terms([{config,MoreConfig}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms, TopCases, SkipList, Config++MoreConfig);
-do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) ->
- do_spec_terms(Terms, TopCases, SkipList,
- update_config(Config, {default_timeout,Tmo}));
-
-do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) ->
- NodeNames0=generate_nodenames(NumNames),
- NodeNames=lists:delete([], NodeNames0),
- do_spec_terms(Terms, TopCases, SkipList,
- update_config(Config, {nodenames,NodeNames}));
-do_spec_terms([Other|Terms], TopCases, SkipList, Config) ->
- io:format("** WARNING: Spec file contains unknown directive ~p\n",
- [Other]),
- do_spec_terms(Terms, TopCases, SkipList, Config).
-
-
-
-generate_nodenames(Num) ->
- Hosts = case controller_call(get_hosts) of
- [] ->
- TI = controller_call(get_target_info),
- [TI#target_info.host];
- List ->
- List
- end,
- generate_nodenames2(Num, Hosts, []).
-
-generate_nodenames2(0, _Hosts, Acc) ->
- Acc;
-generate_nodenames2(N, Hosts, Acc) ->
- Host=lists:nth((N rem (length(Hosts)))+1, Hosts),
- Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host),
- generate_nodenames2(N-1, Hosts, [Name|Acc]).
-
-temp_nodename([], Acc) ->
- lists:flatten(Acc);
-temp_nodename([Chr|Base], Acc) ->
- {A,B,C} = ?now,
- New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)],
- temp_nodename(Base, [New|Acc]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% count_test_cases(TopCases, SkipCases) -> {Suites,NoOfCases} | error
-%% TopCases = term() (See collect_cases/3)
-%% SkipCases = term() (See collect_cases/3)
-%% Suites = list()
-%% NoOfCases = integer() | unknown
-%%
-%% Counts the test cases that are about to run and returns that number.
-%% If there's a conf group in TestSpec with a repeat property, the total number
-%% of cases can not be calculated and NoOfCases = unknown.
-count_test_cases(TopCases, SkipCases) when is_list(TopCases) ->
- case collect_all_cases(TopCases, SkipCases) of
- {error,_Why} = Error ->
- Error;
- TestSpec ->
- {get_suites(TestSpec, []),
- case remove_conf(TestSpec) of
- {repeats,_} ->
- unknown;
- TestSpec1 ->
- length(TestSpec1)
- end}
- end;
-
-count_test_cases(TopCase, SkipCases) ->
- count_test_cases([TopCase], SkipCases).
-
-
-remove_conf(Cases) ->
- remove_conf(Cases, [], false).
-
-remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) ->
- case get_repeat(Props) of
- undefined ->
- remove_conf(Cases, NoConf, Repeats);
- {_RepType,1} ->
- remove_conf(Cases, NoConf, Repeats);
- _ ->
- remove_conf(Cases, NoConf, true)
- end;
-remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) ->
- remove_conf(Cases, NoConf, Repeats);
-remove_conf([{skip_case,{{_M,all},_Cmt},_Mode}|Cases], NoConf, Repeats) ->
- remove_conf(Cases, NoConf, Repeats);
-remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases],
- NoConf, Repeats) when Type==conf;
- Type==make ->
- remove_conf(Cases, NoConf, Repeats);
-remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt},_Mode}|Cases],
- NoConf, Repeats) when Type==conf;
- Type==make ->
- remove_conf(Cases, NoConf, Repeats);
-remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) ->
- FwMod = get_fw_mod(?MODULE),
- if Mod == FwMod ->
- remove_conf(Cases, NoConf, Repeats);
- true ->
- remove_conf(Cases, [C|NoConf], Repeats)
- end;
-remove_conf([C|Cases], NoConf, Repeats) ->
- remove_conf(Cases, [C|NoConf], Repeats);
-remove_conf([], NoConf, true) ->
- {repeats,lists:reverse(NoConf)};
-remove_conf([], NoConf, false) ->
- lists:reverse(NoConf).
-
-get_suites([{skip_case,{{Mod,_F},_Cmt},_Mode}|Tests], Mods) when is_atom(Mod) ->
- case add_mod(Mod, Mods) of
- true -> get_suites(Tests, [Mod|Mods]);
- false -> get_suites(Tests, Mods)
- end;
-get_suites([{Mod,_Case}|Tests], Mods) when is_atom(Mod) ->
- case add_mod(Mod, Mods) of
- true -> get_suites(Tests, [Mod|Mods]);
- false -> get_suites(Tests, Mods)
- end;
-get_suites([{Mod,_Func,_Args}|Tests], Mods) when is_atom(Mod) ->
- case add_mod(Mod, Mods) of
- true -> get_suites(Tests, [Mod|Mods]);
- false -> get_suites(Tests, Mods)
- end;
-get_suites([_|Tests], Mods) ->
- get_suites(Tests, Mods);
-
-get_suites([], Mods) ->
- lists:reverse(Mods).
-
-add_mod(Mod, Mods) ->
- case string:rstr(atom_to_list(Mod), "_SUITE") of
- 0 -> false;
- _ -> % test suite
- case lists:member(Mod, Mods) of
- true -> false;
- false -> true
- end
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) ->
-%% exit(Result)
-%%
-%% TopCases = term() (See collect_cases/3)
-%% SkipCases = term() (See collect_cases/3)
-%% Config = term() (See collect_cases/3)
-%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap}
-%% MultiplyTimetrap = integer() | infinity
-%% ScaleTimetrap = bool()
-%%
-%% Initializes and starts the test run, for "ordinary" test suites.
-%% Creates log directories and log files, inserts initial timestamps and
-%% configuration information into the log files.
-%%
-%% This function is meant to be called by a process created by
-%% spawn_tester/10, which sets up some necessary dictionary values.
-do_test_cases(TopCases, SkipCases,
- Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap);
- MultiplyTimetrap == infinity ->
- do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true});
-
-do_test_cases(TopCases, SkipCases,
- Config, TimetrapData) when is_list(TopCases),
- is_tuple(TimetrapData) ->
- {ok,TestDir} = start_log_file(),
- FwMod = get_fw_mod(?MODULE),
- case collect_all_cases(TopCases, SkipCases) of
- {error,Why} ->
- print(1, "Error starting: ~p", [Why]),
- exit(test_suites_done);
- TestSpec0 ->
- N = case remove_conf(TestSpec0) of
- {repeats,_} -> unknown;
- TS -> length(TS)
- end,
- put(test_server_cases, N),
- put(test_server_case_num, 0),
-
- TestSpec =
- add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod),
-
- TI = get_target_info(),
- print(1, "Starting test~ts",
- [print_if_known(N, {", ~w test cases",[N]},
- {" (with repeated test cases)",[]})]),
- Test = get(test_server_name),
- TestName = if is_list(Test) ->
- lists:flatten(io_lib:format("~ts", [Test]));
- true ->
- lists:flatten(io_lib:format("~tp", [Test]))
- end,
- TestDescr = "Test " ++ TestName ++ " results",
-
- test_server_sup:framework_call(report, [tests_start,{Test,N}]),
-
- {Header,Footer} =
- case test_server_sup:framework_call(get_html_wrapper,
- [TestDescr,true,TestDir,
- {[],[2,3,4,7,8],[1,6]}], "") of
- Empty when (Empty == "") ; (element(2,Empty) == "") ->
- put(basic_html, true),
- {[html_header(TestDescr),
- "<h2>Results for test ", TestName, "</h2>\n"],
- "\n</body>\n</html>\n"};
- {basic_html,Html0,Html1} ->
- put(basic_html, true),
- {Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
- Html1};
- {xhtml,Html0,Html1} ->
- put(basic_html, false),
- {Html0++["<h1>Results for <i>",TestName,"</i></h1>\n"],
- Html1}
- end,
-
- print(html, Header),
-
- print(html, xhtml("<p>", "<h4>")),
- print_timestamp(html, "Test started at "),
- print(html, xhtml("</p>", "</h4>")),
-
- print(html, xhtml("\n<p><b>Host info:</b><br>\n",
- "\n<p><b>Host info:</b><br />\n")),
- print_who(test_server_sup:hoststr(), test_server_sup:get_username()),
- print(html, xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
- "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
- [erlang:system_info(version), code:root_dir()]),
-
- if FwMod == ?MODULE ->
- print(html, xhtml("\n<p><b>Target Info:</b><br>\n",
- "\n<p><b>Target Info:</b><br />\n")),
- print_who(TI#target_info.host, TI#target_info.username),
- print(html,xhtml("<br>Used Erlang v~ts in <tt>~ts</tt></p>\n",
- "<br />Used Erlang v~ts in \"~ts\"</p>\n"),
- [TI#target_info.version, TI#target_info.root_dir]);
- true ->
- case test_server_sup:framework_call(target_info, []) of
- TargetInfo when is_list(TargetInfo),
- length(TargetInfo) > 0 ->
- print(html, xhtml("\n<p><b>Target info:</b><br>\n",
- "\n<p><b>Target info:</b><br />\n")),
- print(html, "~ts</p>\n", [TargetInfo]);
- _ ->
- ok
- end
- end,
- CoverLog =
- case get(test_server_cover_log_dir) of
- undefined ->
- ?coverlog_name;
- AbsLogDir ->
- AbsLog = filename:join(AbsLogDir,?coverlog_name),
- make_relative(AbsLog, TestDir)
- end,
- print(html,
- "<p><ul>\n"
- "<li><a href=\"~ts\">Full textual log</a></li>\n"
- "<li><a href=\"~ts\">Coverage log</a></li>\n"
- "<li><a href=\"~ts\">Unexpected I/O log</a></li>\n</ul></p>\n",
- [?suitelog_name,CoverLog,?unexpected_io_log]),
- print(html,
- "<p>~ts</p>\n" ++
- xhtml(["<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">\n",
- "<thead>\n"],
- ["<table id=\"",?sortable_table_name,"\">\n",
- "<thead>\n"]) ++
- "<tr><th>Num</th><th>Module</th><th>Group</th>" ++
- "<th>Case</th><th>Log</th><th>Time</th><th>Result</th>" ++
- "<th>Comment</th></tr>\n</thead>\n<tbody>\n",
- [print_if_known(N, {"<i>Executing <b>~w</b> test cases...</i>"
- ++ xhtml("\n<br>\n", "\n<br />\n"),[N]},
- {"",[]})]),
-
- print(major, "=cases ~w", [get(test_server_cases)]),
- print(major, "=user ~ts", [TI#target_info.username]),
- print(major, "=host ~ts", [TI#target_info.host]),
-
- %% If there are no hosts specified,use only the local host
- case controller_call(get_hosts) of
- [] ->
- print(major, "=hosts ~ts", [TI#target_info.host]),
- controller_call({set_hosts, [TI#target_info.host]});
- Hosts ->
- Str = lists:flatten(lists:map(fun(X) -> [X," "] end, Hosts)),
- print(major, "=hosts ~ts", [Str])
- end,
- print(major, "=emulator_vsn ~ts", [TI#target_info.version]),
- print(major, "=emulator ~ts", [TI#target_info.emulator]),
- print(major, "=otp_release ~ts", [TI#target_info.otp_release]),
- print(major, "=started ~s",
- [lists:flatten(timestamp_get(""))]),
-
- test_server_io:set_footer(Footer),
-
- run_test_cases(TestSpec, Config, TimetrapData)
- end;
-
-do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) ->
- %% when not list(TopCase)
- do_test_cases([TopCase], SkipCases, Config, TimetrapSpec).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_log_file() -> {ok,TestDirName} | exit({Error,Reason})
-%% Stem = string()
-%%
-%% Creates the log directories, the major log file and the html log file.
-%% The log files are initialized with some header information.
-%%
-%% The name of the log directory will be <Name>.logs/run.<Date>/ where
-%% Name is the test suite name and Date is the current date and time.
-
-start_log_file() ->
- Dir = get(test_server_dir),
- case file:make_dir(Dir) of
- ok ->
- ok;
- {error, eexist} ->
- ok;
- MkDirError ->
- log_file_error(MkDirError, Dir)
- end,
- TestDir = timestamp_filename_get(filename:join(Dir, "run.")),
- TestDir1 =
- case file:make_dir(TestDir) of
- ok ->
- TestDir;
- {error,eexist} ->
- timer:sleep(1000),
- %% we need min 1 second between timestamps unfortunately
- TestDirX = timestamp_filename_get(filename:join(Dir, "run.")),
- case file:make_dir(TestDirX) of
- ok ->
- TestDirX;
- MkDirError2 ->
- log_file_error(MkDirError2, TestDirX)
- end;
- MkDirError2 ->
- log_file_error(MkDirError2, TestDir)
- end,
- FilenameMode = file:native_name_encoding(),
- ok = write_file(filename:join(Dir, ?last_file),
- TestDir1 ++ "\n",
- FilenameMode),
- ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode),
- put(test_server_log_dir_base,TestDir1),
-
- MajorName = filename:join(TestDir1, ?suitelog_name),
- HtmlName = MajorName ++ ?html_ext,
- UnexpectedName = filename:join(TestDir1, ?unexpected_io_log),
-
- {ok,Major} = open_utf8_file(MajorName),
- {ok,Html} = open_html_file(HtmlName),
-
- {UnexpHeader,UnexpFooter} =
- case test_server_sup:framework_call(get_html_wrapper,
- ["Unexpected I/O log",false,
- TestDir, undefined],"") of
- UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "") ->
- {html_header("Unexpected I/O log"),"\n</body>\n</html>\n"};
- {basic_html,UH,UF} ->
- {UH,UF};
- {xhtml,UH,UF} ->
- {UH,UF}
- end,
-
- {ok,Unexpected} = open_html_file(UnexpectedName),
- io:put_chars(Unexpected, [UnexpHeader,
- xhtml("<br>\n<h2>Unexpected I/O</h2>",
- "<br />\n<h3>Unexpected I/O</h3>"),
- "\n<pre>\n"]),
- put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}),
-
- test_server_io:set_fd(major, Major),
- test_server_io:set_fd(html, Html),
- test_server_io:set_fd(unexpected_io, Unexpected),
-
- make_html_link(filename:absname(?last_test ++ ?html_ext),
- HtmlName, filename:basename(Dir)),
- LinkName = filename:join(Dir, ?last_link),
- make_html_link(LinkName ++ ?html_ext, HtmlName,
- filename:basename(Dir)),
-
- PrivDir = filename:join(TestDir1, ?priv_dir),
- ok = file:make_dir(PrivDir),
- put(test_server_priv_dir,PrivDir++"/"),
- print_timestamp(major, "Suite started at "),
-
- LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
- test_server_sup:framework_call(report, [loginfo,LogInfo]),
- {ok,TestDir1}.
-
-log_file_error(Error, Dir) ->
- exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}).
-
-make_html_link(LinkName, Target, Explanation) ->
- %% if possible use a relative reference to Target.
- TargetL = filename:split(Target),
- PwdL = filename:split(filename:dirname(LinkName)),
- Href = case lists:prefix(PwdL, TargetL) of
- true ->
- uri_encode(filename:join(lists:nthtail(length(PwdL),TargetL)));
- false ->
- "file:" ++ uri_encode(Target)
- end,
- H = [html_header(Explanation),
- "<h1>Last test</h1>\n"
- "<a href=\"",Href,"\">",Explanation,"</a>\n"
- "</body>\n</html>\n"],
- ok = write_html_file(LinkName, H).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
-%% Mod = atom()
-%% Func = atom()
-%% ParallelTC = bool()
-%% AbsName = string()
-%%
-%% Create a minor log file for the test case Mod,Func,Args. The log file
-%% will be stored in the log directory under the name <Mod>.<Func>.html.
-%% Some header info will also be inserted into the log file. If the test
-%% case runs in a parallel group, then to avoid clashing file names if the
-%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html
-%% is used.
-
-start_minor_log_file(Mod, Func, ParallelTC) ->
- MFA = {Mod,Func,1},
- LogDir = get(test_server_log_dir_base),
- Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
- Name = downcase(Name0),
- AbsName = filename:join(LogDir, Name),
- case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
- false -> %% normal case, unique name
- start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
- true -> %% special case, duplicate names
- Tag = test_server_sup:unique_name(),
- Name1_0 =
- lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
- ?html_ext])),
- Name1 = downcase(Name1_0),
- AbsName1 = filename:join(LogDir, Name1),
- start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
- end.
-
-start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
- {ok,Fd} = open_html_file(AbsName),
- Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
- put(test_server_minor_fd, Fd),
- test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
-
- TestDescr = io_lib:format("Test ~w:~w result", [Mod,Func]),
- {Header,Footer} =
- case test_server_sup:framework_call(get_html_wrapper,
- [TestDescr,false,
- filename:dirname(AbsName),
- undefined], "") of
- Empty when (Empty == "") ; (element(2,Empty) == "") ->
- put(basic_html, true),
- {html_header(TestDescr), "\n</body>\n</html>\n"};
- {basic_html,Html0,Html1} ->
- put(basic_html, true),
- {Html0,Html1};
- {xhtml,Html0,Html1} ->
- put(basic_html, false),
- {Html0,Html1}
- end,
- put(test_server_minor_footer, Footer),
- io:put_chars(Fd, Header),
-
- io:put_chars(Fd, "<a name=\"top\"></a>"),
- io:put_chars(Fd, "<pre>\n"),
-
- SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
-
- case get_fw_mod(?MODULE) of
- Mod when Func == error_in_suite ->
- ok;
- _ ->
- {Info,Arity} =
- if Func == init_per_suite; Func == end_per_suite ->
- {"Config function: ", 1};
- Func == init_per_group; Func == end_per_group ->
- {"Config function: ", 2};
- true ->
- {"Test case: ", 1}
- end,
-
- case {filelib:is_file(filename:join(LogDir, SrcListing)),
- lists:member(no_src, get(test_server_logopts))} of
- {true,false} ->
- print(Lev, Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> "
- "(click for source code)\n",
- [uri_encode(SrcListing),
- uri_encode(atom_to_list(Func)++"-1",utf8),
- Mod,Func,Arity]);
- _ ->
- print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity])
- end
- end,
-
- AbsName.
-
-stop_minor_log_file() ->
- test_server_gl:unset_minor_fd(group_leader()),
- Fd = get(test_server_minor_fd),
- Footer = get(test_server_minor_footer),
- io:put_chars(Fd, "</pre>\n" ++ Footer),
- ok = file:close(Fd),
- put(test_server_minor_fd, undefined).
-
-downcase(S) -> downcase(S, []).
-downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
- downcase(Rest, [Uc-$A+$a|Result]);
-downcase([C|Rest], Result) ->
- downcase(Rest, [C|Result]);
-downcase([], Result) ->
- lists:reverse(Result).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% html_convert_modules(TestSpec, Config) -> ok
-%% Isolate the modules affected by TestSpec and
-%% make sure they are converted to html.
-%%
-%% Errors are silently ignored.
-
-html_convert_modules(TestSpec, _Config, FwMod) ->
- Mods = html_isolate_modules(TestSpec, FwMod),
- html_convert_modules(Mods),
- copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).
-
-%% Retrieve a list of modules out of the test spec.
-html_isolate_modules(List, FwMod) ->
- html_isolate_modules(List, sets:new(), FwMod).
-
-html_isolate_modules([], Set, _) -> sets:to_list(Set);
-html_isolate_modules([{skip_case,{_Case,_Cmt},_Mode}|Cases], Set, FwMod) ->
- html_isolate_modules(Cases, Set, FwMod);
-html_isolate_modules([{conf,_Ref,Props,{FwMod,_Func}}|Cases], Set, FwMod) ->
- Set1 = case proplists:get_value(suite, Props) of
- undefined -> Set;
- Mod -> sets:add_element(Mod, Set)
- end,
- html_isolate_modules(Cases, Set1, FwMod);
-html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set, FwMod) ->
- html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{skip_case,{conf,_Ref,{FwMod,_Func},_Cmt},Mode}|Cases],
- Set, FwMod) ->
- Set1 = case proplists:get_value(suite, get_props(Mode)) of
- undefined -> Set;
- Mod -> sets:add_element(Mod, Set)
- end,
- html_isolate_modules(Cases, Set1, FwMod);
-html_isolate_modules([{skip_case,{conf,_Ref,{Mod,_Func},_Cmt},_Props}|Cases],
- Set, FwMod) ->
- html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{Mod,_Case}|Cases], Set, FwMod) ->
- html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{Mod,_Case,_Args}|Cases], Set, FwMod) ->
- html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod).
-
-%% Given a list of modules, convert each module's source code to HTML.
-html_convert_modules([Mod|Mods]) ->
- case code:which(Mod) of
- Path when is_list(Path) ->
- SrcFile = filename:rootname(Path) ++ ".erl",
- FoundSrcFile =
- case file:read_file_info(SrcFile) of
- {ok,SInfo} ->
- {SrcFile,SInfo};
- {error,_} ->
- ModInfo = Mod:module_info(compile),
- case proplists:get_value(source, ModInfo) of
- undefined ->
- undefined;
- OtherSrcFile ->
- case file:read_file_info(OtherSrcFile) of
- {ok,SInfo} ->
- {OtherSrcFile,SInfo};
- {error,_} ->
- undefined
- end
- end
- end,
- case FoundSrcFile of
- undefined ->
- html_convert_modules(Mods);
- {SrcFile1,SrcFileInfo} ->
- DestDir = get(test_server_dir),
- Name = atom_to_list(Mod),
- DestFile = filename:join(DestDir,
- downcase(Name)++?src_listing_ext),
- html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
- html_convert_modules(Mods)
- end;
- _Other ->
- html_convert_modules(Mods)
- end;
-html_convert_modules([]) -> ok.
-
-%% Convert source code to HTML if possible and needed.
-html_possibly_convert(Src, SrcInfo, Dest) ->
- case file:read_file_info(Dest) of
- {ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime ->
- ok; % dest file up to date
- _ ->
- InclPath = case application:get_env(test_server, include) of
- {ok,Incls} -> Incls;
- _ -> []
- end,
-
- OutDir = get(test_server_log_dir_base),
- case test_server_sup:framework_call(get_html_wrapper,
- ["Module "++Src,false,
- OutDir,undefined,
- encoding(Src)], "") of
- Empty when (Empty == "") ; (element(2,Empty) == "") ->
- erl2html2:convert(Src, Dest, InclPath);
- {_,Header,_} ->
- erl2html2:convert(Src, Dest, InclPath, Header)
- end
- end.
-
-%% Copy all HTML files in InDir to OutDir.
-copy_html_files(InDir, OutDir) ->
- Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
- lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).
-
-copy_html_file(Src, DestDir) ->
- Dest = filename:join(DestDir, filename:basename(Src)),
- case file:read_file(Src) of
- {ok,Bin} ->
- ok = write_binary_file(Dest, Bin);
- {error,_Reason} ->
- io:format("File ~ts: read failed\n", [Src])
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
-%%
-%% Expands TestSpec with an initial init_per_suite, and a final
-%% end_per_suite element, per each discovered suite in the list.
-
-add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
-add_init_and_end_per_suite([{skip_case,{{Mod,all},_},_}=Case|Cases], LastMod,
- LastRef, FwMod) when Mod =/= LastMod ->
- {PreCases, NextMod, NextRef} =
- do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([{skip_case,{{Mod,_},_Cmt},_Mode}=Case|Cases],
- LastMod, LastRef, FwMod) when Mod =/= LastMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_},_}=Case|Cases],
- LastMod, LastRef, FwMod) when Mod =/= LastMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod,
- LastRef, FwMod) when Mod =/= LastMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
- LastRef, FwMod) ->
- %% if Mod == FwMod, this conf test is (probably) a test case group where
- %% the init- and end-functions are missing in the suite, and if so,
- %% the suite name should be stored as {suite,Suite} in Props
- case proplists:get_value(suite, Props) of
- Suite when Suite =/= undefined, Suite =/= LastMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
- Case1 = {conf,Ref,[{suite,NextMod}|proplists:delete(suite,Props)],
- {FwMod,Func}},
- PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
- _ ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
- end;
-add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod,
- LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod)
- when element(1,SkipCase) == skip_case; element(1,SkipCase) == auto_skip_case->
- [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
-add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
-add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod)
- when Mod =/= LastMod, Mod =/= FwMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod)
- when Mod =/= LastMod, Mod =/= FwMod ->
- {PreCases, NextMod, NextRef} =
- do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod),
- PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod,
- NextRef, FwMod)];
-add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)->
- [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
-add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) ->
- [];
-add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
- [];
-add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
- %% we'll add end_per_suite here even if it's not exported
- %% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}];
- false ->
- %% let's call a "fake" end_per_suite if it exists
- case erlang:function_exported(FwMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
- false ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}]
- end
- end.
-
-do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
- case code:is_loaded(Mod) of
- false -> code:load_file(Mod);
- _ -> ok
- end,
- {Init,NextMod,NextRef} =
- case erlang:function_exported(Mod, init_per_suite, 1) of
- true ->
- Ref = make_ref(),
- {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
- false ->
- %% let's call a "fake" init_per_suite if it exists
- case erlang:function_exported(FwMod, init_per_suite, 1) of
- true ->
- Ref = make_ref(),
- {[{conf,Ref,[{suite,Mod}],
- {FwMod,init_per_suite}}],Mod,Ref};
- false ->
- {[],Mod,undefined}
- end
-
- end,
- Cases =
- if LastRef==undefined ->
- Init;
- LastRef==skipped_suite ->
- Init;
- true ->
- %% we'll add end_per_suite here even if it's not exported
- %% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
- false ->
- %% let's call a "fake" end_per_suite if it exists
- case erlang:function_exported(FwMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[{suite,Mod}],
- {FwMod,end_per_suite}}|Init];
- false ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
- end
- end
- end,
- {Cases,NextMod,NextRef}.
-
-do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
- case LastRef of
- No when No==undefined ; No==skipped_suite ->
- {[],Mod,skipped_suite};
- _Ref ->
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- {[{conf,LastRef,[],{LastMod,end_per_suite}}],
- Mod,skipped_suite};
- false ->
- case erlang:function_exported(FwMod, end_per_suite, 1) of
- true ->
- %% let's call "fake" end_per_suite if it exists
- {[{conf,LastRef,[],{FwMod,end_per_suite}}],
- Mod,skipped_suite};
- false ->
- {[{conf,LastRef,[],{LastMod,end_per_suite}}],
- Mod,skipped_suite}
- end
- end
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result)
-%%
-%% Runs the specified tests, then displays/logs the summary.
-
-run_test_cases(TestSpec, Config, TimetrapData) ->
- test_server:init_purify(),
- case lists:member(no_src, get(test_server_logopts)) of
- true ->
- ok;
- false ->
- FwMod = get_fw_mod(?MODULE),
- html_convert_modules(TestSpec, Config, FwMod)
- end,
-
- run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
-
- {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
- case get(test_server_skipped) of
- {0,0} -> {0,0,0,""};
- {US,AS} -> {US+AS,US,AS,io_lib:format(", ~w skipped", [US+AS])}
- end,
- OkN = get(test_server_ok),
- FailedN = get(test_server_failed),
- print(1, "TEST COMPLETE, ~w ok, ~w failed~ts of ~w test cases\n",
- [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]),
- test_server_sup:framework_call(report, [tests_done,
- {OkN,FailedN,{UserSkipN,AutoSkipN}}]),
- print(major, "=finished ~s", [lists:flatten(timestamp_get(""))]),
- print(major, "=failed ~w", [FailedN]),
- print(major, "=successful ~w", [OkN]),
- print(major, "=user_skipped ~w", [UserSkipN]),
- print(major, "=auto_skipped ~w", [AutoSkipN]),
- exit(test_suites_done).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
-%% TestCases = [Test,...]
-%% Config = [[{Key,Val},...],...]
-%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}
-%% MultiplyTimetrap = integer() | infinity
-%% ScaleTimetrap = bool()
-%% Mode = [{Ref,[Prop,..],StartTime}]
-%% Ref = reference()
-%% Prop = {name,Name} | sequence | parallel |
-%% shuffle | {shuffle,Seed} |
-%% repeat | {repeat,N} |
-%% repeat_until_all_ok | {repeat_until_all_ok,N} |
-%% repeat_until_any_ok | {repeat_until_any_ok,N} |
-%% repeat_until_any_fail | {repeat_until_any_fail,N} |
-%% repeat_until_all_fail | {repeat_until_all_fail,N}
-%% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}]
-%% Ok = Skipped = Failed = [Case,...]
-%%
-%% Execute the TestCases under configuration Config. Config is a list
-%% of lists, where hd(Config) holds the config tuples for the current
-%% conf case and tl(Config) is the data for the higher level conf cases.
-%% Config data is "inherited" from top to nested conf cases, but
-%% never the other way around. if length(Config) == 1, Config contains
-%% only the initial config data for the suite.
-%%
-%% Test may be one of the following:
-%%
-%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification
-%% function, call it with the current configuration as argument. It will
-%% return a new configuration.
-%%
-%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called
-%% with the given arguments.
-%%
-%% {Mod,Case} This is a normal test case. Determine the correct
-%% configuration, and insert {Mod,Case,Config} as head of the list,
-%% then reiterate.
-%%
-%% {Mod,Case,Args} A test case with predefined argument (usually a normal
-%% test case which just got a fresh configuration (see above)).
-%%
-%% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped
-%% by the user. This will also cause the end conf case to be skipped.
-%% Note that it is not possible to skip an end conf case directly (it
-%% can only be skipped indirectly by a skipped init conf case). The
-%% comment (which gets printed in the log files) describes why the case
-%% was skipped.
-%%
-%% {skip_case,{Case,Comment},Mode} A normal test case skipped by the user.
-%% The comment (which gets printed in the log files) describes why the
-%% case was skipped.
-%%
-%% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of
-%% an end conf case being automatically skipped due to a failing init
-%% conf case. It could also be a nested conf case that gets skipped
-%% because of a failed or skipped top level conf.
-%%
-%% {auto_skip_case,{Case,Comment},Mode} This is a normal test case which
-%% gets automatically skipped because of a failing init conf case or
-%% because of a failing previous test case in a sequence.
-%%
-%% -------------------------------------------------------------------
-%% Description of IO handling during execution of parallel test cases:
-%% -------------------------------------------------------------------
-%%
-%% A conf group can have an associated list of properties. If the
-%% parallel property is specified for a group, it means the test cases
-%% should be spawned and run in parallel rather than called sequentially
-%% (which is always the default mode). Test cases that execute in parallel
-%% also write to their respective minor log files in parallel. Printouts
-%% to common log files, such as the summary html file and the major log
-%% file on text format, still have to be processed sequentially. For this
-%% reason, the Mode argument specifies if a parallel group is currently
-%% being executed.
-%%
-%% The low-level mechanism for buffering IO for the common log files
-%% is handled by the test_server_io module. Buffering is turned on by
-%% test_server_io:start_transaction/0 and off by calling
-%% test_server_io:end_transaction/0. The buffered data for the transaction
-%% can printed by calling test_server_io:print_buffered/1.
-%%
-%% This module is responsible for turning on IO buffering and to later
-%% test_server_io:print_buffered/1 to print the data. To help with this,
-%% two variables in the process dictionary are used:
-%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
-%% are set to as follwing:
-%%
-%% Value Meaning
-%% ----- -------
-%% undefined No parallel test cases running
-%% {tc,Pid} Running test cases in a top-level parallel group
-%% {Ref,Pid} Running sequential test case inside a parallel group
-%%
-%% FIXME: The Pid is no longer used.
-%%
-%% If a conf group nested under a parallel group in the test
-%% specification should be started, the 'test_server_common_io_handler'
-%% value gets set also on the main process.
-%%
-%% During execution of a parallel group (or of a group nested under a
-%% parallel group), *any* new test case being started gets registered
-%% in a list saved in the dictionary with 'test_server_queued_io' as key.
-%% When the top level parallel group is finished (only then can we be
-%% sure all parallel test cases have finished and "reported in"), the
-%% list of test cases is traversed in order and test_server_io:print_buffered/1
-%% can be called for each test case. See handle_test_case_io_and_status/0
-%% for details.
-%%
-%% To be able to handle nested conf groups with different properties,
-%% the Mode argument specifies a list of {Ref,Properties} tuples.
-%% The head of the Mode list at any given time identifies the group
-%% currently being processed. The tail of the list identifies groups
-%% on higher level.
-%%
-%% -------------------------------------------------------------------
-%% Notes on parallel execution of test cases
-%% -------------------------------------------------------------------
-%%
-%% A group nested under a parallel group will start executing in
-%% parallel with previous (parallel) test cases (no matter what
-%% properties the nested group has). Test cases are however never
-%% executed in parallel with the start or end conf case of the same
-%% group! Because of this, the test_server_ctrl loop waits at
-%% the end conf of a group for all parallel cases to finish
-%% before the end conf case actually executes. This has the effect
-%% that it's only after a nested group has finished that any
-%% remaining parallel cases in the previous group get spawned (*).
-%% Example (all parallel cases):
-%%
-%% group1_init |---->
-%% group1_case1 | --------->
-%% group1_case2 | --------------------------------->
-%% group2_init | ---->
-%% group2_case1 | ------>
-%% group2_case2 | ---------->
-%% group2_end | --->
-%% group1_case3 (*)| ---->
-%% group1_case4 (*)| -->
-%% group1_end | --->
-%%
-
-run_test_cases_loop([{SkipTag,CaseData={Type,_Ref,_Case,_Comment}}|Cases],
- Config, TimetrapData, Mode, Status) when
- ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
- ((Type==conf) or (Type==make)) ->
- run_test_cases_loop([{SkipTag,CaseData,Mode}|Cases],
- Config, TimetrapData, Mode, Status);
-
-run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases],
- Config, TimetrapData, Mode, Status) when
- ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
- ((Type==conf) or (Type==make)) ->
- file:set_cwd(filename:dirname(get(test_server_dir))),
- CurrIOHandler = get(test_server_common_io_handler),
- ParentMode = tl(Mode),
-
- {AutoOrUser,ReportTag} =
- if SkipTag == auto_skip_case -> {auto,tc_auto_skip};
- SkipTag == skip_case -> {user,tc_user_skip}
- end,
-
- %% check and update the mode for test case execution and io msg handling
- case {curr_ref(Mode),check_props(parallel, Mode)} of
- {Ref,Ref} ->
- case check_props(parallel, ParentMode) of
- false ->
- %% this is a skipped end conf for a top level parallel
- %% group, buffered io can be flushed
- handle_test_case_io_and_status(),
- set_io_buffering(undefined),
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- false, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report,
- [ReportTag,ConfData]),
- run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
- delete_status(Ref, Status));
- _ ->
- %% this is a skipped end conf for a parallel group nested
- %% under a parallel group (io buffering is active)
- wait_for_cases(Ref),
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- true, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report, [ReportTag,ConfData]),
- case CurrIOHandler of
- {Ref,_} ->
- %% current_io_handler was set by start conf of this
- %% group, so we can unset it now (no more io from main
- %% process needs to be buffered)
- set_io_buffering(undefined);
- _ ->
- ok
- end,
- run_test_cases_loop(Cases, Config,
- TimetrapData, ParentMode,
- delete_status(Ref, Status))
- end;
- {Ref,false} ->
- %% this is a skipped end conf for a non-parallel group that's not
- %% nested under a parallel group
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- false, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report, [ReportTag,ConfData]),
-
- %% Check if this group is auto skipped because of error in the
- %% init conf. If so, check if the parent group is a sequence,
- %% and if it is, skip all proceeding tests in that group.
- GrName = get_name(Mode),
- Cases1 =
- case get_tc_results(Status) of
- {_,_,Fails} when length(Fails) > 0 ->
- case lists:member({group_result,GrName}, Fails) of
- true ->
- case check_prop(sequence, ParentMode) of
- false ->
- Cases;
- ParentRef ->
- Reason = {group_result,GrName,failed},
- skip_cases_upto(ParentRef, Cases,
- Reason, tc, ParentMode,
- SkipTag)
- end;
- false ->
- Cases
- end;
- _ ->
- Cases
- end,
- run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode,
- delete_status(Ref, Status));
- {Ref,_} ->
- %% this is a skipped end conf for a non-parallel group nested under
- %% a parallel group (io buffering is active)
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- true, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report, [ReportTag,ConfData]),
- case CurrIOHandler of
- {Ref,_} ->
- %% current_io_handler was set by start conf of this
- %% group, so we can unset it now (no more io from main
- %% process needs to be buffered)
- set_io_buffering(undefined);
- _ ->
- ok
- end,
- run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode),
- delete_status(Ref, Status));
- {_,false} ->
- %% this is a skipped start conf for a group which is not nested
- %% under a parallel group
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- false, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report, [ReportTag,ConfData]),
- run_test_cases_loop(Cases, Config, TimetrapData,
- [conf(Ref,[])|Mode], Status);
- {_,Ref0} when is_reference(Ref0) ->
- %% this is a skipped start conf for a group nested under a parallel
- %% group and if this is the first nested group, io buffering must
- %% be activated
- if CurrIOHandler == undefined ->
- set_io_buffering({Ref,self()});
- true ->
- ok
- end,
- {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
- true, SkipMode),
- ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
- test_server_sup:framework_call(report, [ReportTag,ConfData]),
- run_test_cases_loop(Cases, Config, TimetrapData,
- [conf(Ref,[])|Mode], Status)
- end;
-
-run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases],
- Config, TimetrapData, Mode, Status) ->
- {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1,
- Case, Comment, is_io_buffered(), SkipMode),
- test_server_sup:framework_call(report, [tc_auto_skip,
- {Mod,{Func,get_name(SkipMode)},
- Comment}]),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode,
- update_status(skipped, Mod, Func, Status));
-
-run_test_cases_loop([{skip_case,{{Mod,all}=Case,Comment},SkipMode}|Cases],
- Config, TimetrapData, Mode, Status) ->
- skip_case(user, undefined, 0, Case, Comment, false, SkipMode),
- test_server_sup:framework_call(report, [tc_user_skip,
- {Mod,{all,get_name(SkipMode)},
- Comment}]),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
-
-run_test_cases_loop([{skip_case,{Case,Comment},SkipMode}|Cases],
- Config, TimetrapData, Mode, Status) ->
- {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1,
- Case, Comment, is_io_buffered(), SkipMode),
- test_server_sup:framework_call(report, [tc_user_skip,
- {Mod,{Func,get_name(SkipMode)},
- Comment}]),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode,
- update_status(skipped, Mod, Func, Status));
-
-%% a start *or* end conf case, wrapping test cases or other conf cases
-run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
- Config, TimetrapData, Mode0, Status) ->
- CurrIOHandler = get(test_server_common_io_handler),
- %% check and update the mode for test case execution and io msg handling
- {StartConf,Mode,IOHandler,ConfTime,Status1} =
- case {curr_ref(Mode0),check_props(parallel, Mode0)} of
- {Ref,Ref} ->
- case check_props(parallel, tl(Mode0)) of
- false ->
- %% this is an end conf for a top level parallel group,
- %% collect results from the test case processes
- %% and calc total time
- OkSkipFail = handle_test_case_io_and_status(),
- file:set_cwd(filename:dirname(get(test_server_dir))),
- After = ?now,
- Before = get(test_server_parallel_start_time),
- Elapsed = timer:now_diff(After, Before)/1000000,
- put(test_server_total_time, Elapsed),
- {false,tl(Mode0),undefined,Elapsed,
- update_status(Ref, OkSkipFail, Status)};
- _ ->
- %% this is an end conf for a parallel group nested under a
- %% parallel group (io buffering is active)
- OkSkipFail = wait_for_cases(Ref),
- queue_test_case_io(Ref, self(), 0, Mod, Func),
- Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
- case CurrIOHandler of
- {Ref,_} ->
- %% current_io_handler was set by start conf of this
- %% group, so we can unset it after this case (no
- %% more io from main process needs to be buffered)
- {false,tl(Mode0),undefined,Elapsed,
- update_status(Ref, OkSkipFail, Status)};
- _ ->
- {false,tl(Mode0),CurrIOHandler,Elapsed,
- update_status(Ref, OkSkipFail, Status)}
- end
- end;
- {Ref,false} ->
- %% this is an end conf for a non-parallel group that's not
- %% nested under a parallel group, so no need to buffer io
- {false,tl(Mode0),undefined,
- timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status};
- {Ref,_} ->
- %% this is an end conf for a non-parallel group nested under
- %% a parallel group (io buffering is active)
- queue_test_case_io(Ref, self(), 0, Mod, Func),
- Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
- case CurrIOHandler of
- {Ref,_} ->
- %% current_io_handler was set by start conf of this
- %% group, so we can unset it after this case (no
- %% more io from main process needs to be buffered)
- {false,tl(Mode0),undefined,Elapsed,Status};
- _ ->
- {false,tl(Mode0),CurrIOHandler,Elapsed,Status}
- end;
- {_,false} ->
- %% this is a start conf for a group which is not nested under a
- %% parallel group, check if this case starts a new parallel group
- case lists:member(parallel, Props) of
- true ->
- %% prepare for execution of parallel group
- put(test_server_parallel_start_time, ?now),
- put(test_server_queued_io, []);
- false ->
- ok
- end,
- {true,[conf(Ref,Props)|Mode0],undefined,0,Status};
- {_,_Ref0} ->
- %% this is a start conf for a group nested under a parallel group, the
- %% parallel_start_time and parallel_test_cases values have already been set
- queue_test_case_io(Ref, self(), 0, Mod, Func),
- %% if this is the first nested group under a parallel group, io
- %% buffering must be activated
- IOHandler1 = if CurrIOHandler == undefined ->
- IOH = {Ref,self()},
- set_io_buffering(IOH),
- IOH;
- true ->
- CurrIOHandler
- end,
- {true,[conf(Ref,Props)|Mode0],IOHandler1,0,Status}
- end,
-
- %% if this is a start conf we check if cases should be shuffled
- {[_Conf|Cases1]=Cs1,Shuffle} =
- if StartConf ->
- case get_shuffle(Props) of
- undefined ->
- {Cs0,undefined};
- {_,repeated} ->
- %% if group is repeated, a new seed should not be set every
- %% turn - last one is saved in dictionary
- CurrSeed = get(test_server_curr_random_seed),
- {shuffle_cases(Ref, Cs0, CurrSeed),{shuffle,CurrSeed}};
- {_,Seed} ->
- UseSeed=
- %% Determine which seed to use by:
- %% 1. check the TS_RANDOM_SEED env variable
- %% 2. check random_seed in process state
- %% 3. use value provided with shuffle option
- %% 4. use timestamp() values for seed
- case os:getenv("TS_RANDOM_SEED") of
- Undef when Undef == false ; Undef == "undefined" ->
- case get(test_server_random_seed) of
- undefined -> Seed;
- TSRS -> TSRS
- end;
- NumStr ->
- %% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
- list_to_tuple([list_to_integer(NS) ||
- NS <- string:tokens(NumStr, [$ ,$:,$,])])
- end,
- {shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
- end;
- not StartConf ->
- {Cs0,undefined}
- end,
-
- %% if this is a start conf we check if Props specifies repeat and if so
- %% we copy the group and carry the copy until the end conf where we
- %% decide to perform the repetition or not
- {Repeating,Status2,Cases,ReportRepeatStop} =
- if StartConf ->
- case get_repeat(Props) of
- undefined ->
- %% we *must* have a status entry for every conf since we
- %% will continously update status with test case results
- %% without knowing the Ref (but update hd(Status))
- {false,new_status(Ref, Status1),Cases1,?void_fun};
- {_RepType,N} when N =< 1 ->
- {false,new_status(Ref, Status1),Cases1,?void_fun};
- _ ->
- {Copied,_} = copy_cases(Ref, make_ref(), Cs1),
- {true,new_status(Ref, Copied, Status1),Cases1,?void_fun}
- end;
- not StartConf ->
- RepVal = get_repeat(get_props(Mode0)),
- ReportStop =
- fun() ->
- print(minor, "~n*** Stopping repeat operation ~w", [RepVal]),
- print(1, "Stopping repeat operation ~w", [RepVal])
- end,
- CopiedCases = get_copied_cases(Status1),
- EndStatus = delete_status(Ref, Status1),
- %% check in Mode0 if this is a repeat conf
- case RepVal of
- undefined ->
- {false,EndStatus,Cases1,?void_fun};
- {_RepType,N} when N =< 1 ->
- {false,EndStatus,Cases1,?void_fun};
- {repeat,_} ->
- {true,EndStatus,CopiedCases++Cases1,?void_fun};
- {repeat_until_all_ok,_} ->
- {RestCs,Fun} = case get_tc_results(Status1) of
- {_,_,[]} ->
- {Cases1,ReportStop};
- _ ->
- {CopiedCases++Cases1,?void_fun}
- end,
- {true,EndStatus,RestCs,Fun};
- {repeat_until_any_ok,_} ->
- {RestCs,Fun} = case get_tc_results(Status1) of
- {Ok,_,_Fails} when length(Ok) > 0 ->
- {Cases1,ReportStop};
- _ ->
- {CopiedCases++Cases1,?void_fun}
- end,
- {true,EndStatus,RestCs,Fun};
- {repeat_until_any_fail,_} ->
- {RestCs,Fun} = case get_tc_results(Status1) of
- {_,_,Fails} when length(Fails) > 0 ->
- {Cases1,ReportStop};
- _ ->
- {CopiedCases++Cases1,?void_fun}
- end,
- {true,EndStatus,RestCs,Fun};
- {repeat_until_all_fail,_} ->
- {RestCs,Fun} = case get_tc_results(Status1) of
- {[],_,_} ->
- {Cases1,ReportStop};
- _ ->
- {CopiedCases++Cases1,?void_fun}
- end,
- {true,EndStatus,RestCs,Fun}
- end
- end,
-
- ReportAbortRepeat = fun(What) when Repeating ->
- print(minor, "~n*** Aborting repeat operation "
- "(configuration case ~w)", [What]),
- print(1, "Aborting repeat operation "
- "(configuration case ~w)", [What]);
- (_) -> ok
- end,
- CfgProps = if StartConf ->
- if Shuffle == undefined ->
- [{tc_group_properties,Props}];
- true ->
- [{tc_group_properties,
- [Shuffle|delete_shuffle(Props)]}]
- end;
- not StartConf ->
- {TcOk,TcSkip,TcFail} = get_tc_results(Status1),
- [{tc_group_properties,get_props(Mode0)},
- {tc_group_result,[{ok,TcOk},
- {skipped,TcSkip},
- {failed,TcFail}]}]
- end,
-
- SuiteName = proplists:get_value(suite, Props),
- case get(test_server_create_priv_dir) of
- auto_per_run -> % use common priv_dir
- TSDirs = [{priv_dir,get(test_server_priv_dir)},
- {data_dir,get_data_dir(Mod, SuiteName)}];
- _ ->
- TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
- end,
-
- ActualCfg =
- if not StartConf ->
- update_config(hd(Config), TSDirs ++ CfgProps);
- true ->
- GroupPath = lists:flatmap(fun({_Ref,[],_T}) -> [];
- ({_Ref,GrProps,_T}) -> [GrProps]
- end, Mode0),
- update_config(hd(Config),
- TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
- end,
-
- CurrMode = curr_mode(Ref, Mode0, Mode),
- ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
- TimetrapData, CurrMode),
-
- case ConfCaseResult of
- {_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) ->
- %% check that init_per_suite returned data on correct format
- case lists:filter(fun({_,_}) -> false;
- (_) -> true end, NewCfg) of
- [] ->
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases, [NewCfg|Config],
- TimetrapData, Mode, Status2);
- Bad ->
- print(minor,
- "~n*** ~w returned bad elements in Config: ~p.~n",
- [Func,Bad]),
- Reason = {failed,{Mod,init_per_suite,bad_return}},
- Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
- auto_skip_case),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
- delete_status(Ref, Status2))
- end;
- {_,NewCfg,_} when StartConf, is_list(NewCfg) ->
- print_conf_time(ConfTime),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
- {_,{framework_error,{FwMod,FwFunc},Reason},_} ->
- print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
- [FwMod,FwFunc,Reason]),
- print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
- exit(framework_error);
- {_,Fail,_} when element(1,Fail) == 'EXIT';
- element(1,Fail) == timetrap_timeout;
- element(1,Fail) == user_timetrap_error;
- element(1,Fail) == failed ->
- {Cases2,Config1,Status3} =
- if StartConf ->
- ReportAbortRepeat(failed),
- print(minor, "~n*** ~w failed.~n"
- " Skipping all cases.", [Func]),
- Reason = {failed,{Mod,Func,Fail}},
- {skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
- auto_skip_case),
- Config,
- update_status(failed, group_result, get_name(Mode),
- delete_status(Ref, Status2))};
- not StartConf ->
- ReportRepeatStop(),
- print_conf_time(ConfTime),
- {Cases,tl(Config),delete_status(Ref, Status2)}
- end,
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
-
- {_,{auto_skip,SkipReason},_} ->
- %% this case can only happen if the framework (not the user)
- %% decides to skip execution of a conf function
- {Cases2,Config1,Status3} =
- if StartConf ->
- ReportAbortRepeat(auto_skipped),
- print(minor, "~n*** ~w auto skipped.~n"
- " Skipping all cases.", [Func]),
- {skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
- auto_skip_case),
- Config,
- delete_status(Ref, Status2)};
- not StartConf ->
- ReportRepeatStop(),
- print_conf_time(ConfTime),
- {Cases,tl(Config),delete_status(Ref, Status2)}
- end,
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
-
- {_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
- ReportAbortRepeat(skipped),
- print(minor, "~n*** ~w skipped.~n"
- " Skipping all cases.", [Func]),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
- CurrMode, skip_case),
- [hd(Config)|Config], TimetrapData, Mode,
- delete_status(Ref, Status2));
- {_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
- ReportAbortRepeat(skipped),
- print(minor, "~n*** ~w skipped.~n"
- " Skipping all cases.", [Func]),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
- CurrMode, skip_case),
- [hd(Config)|Config], TimetrapData, Mode,
- delete_status(Ref, Status2));
- {_,_Other,_} when Func == init_per_suite ->
- print(minor, "~n*** init_per_suite failed to return a Config list.~n", []),
- Reason = {failed,{Mod,init_per_suite,bad_return}},
- Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
- auto_skip_case),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
- delete_status(Ref, Status2));
- {_,_Other,_} when StartConf ->
- print_conf_time(ConfTime),
- set_io_buffering(IOHandler),
- ReportRepeatStop(),
- stop_minor_log_file(),
- run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData,
- Mode, Status2);
- {_,_EndConfRetVal,Opts} ->
- %% Check if return_group_result is set (ok, skipped or failed) and
- %% if so:
- %% 1) *If* the parent group is a sequence, skip all proceeding tests
- %% in that group.
- %% 2) Return the value to the group "above" so that result may be
- %% used for evaluating a 'repeat_until_*' property.
- GrName = get_name(Mode0, Func),
- {Cases2,Status3} =
- case lists:keysearch(return_group_result, 1, Opts) of
- {value,{_,failed}} ->
- case {curr_ref(Mode),check_prop(sequence, Mode)} of
- {ParentRef,ParentRef} ->
- Reason = {group_result,GrName,failed},
- {skip_cases_upto(ParentRef, Cases, Reason, tc,
- Mode, auto_skip_case),
- update_status(failed, group_result, GrName,
- delete_status(Ref, Status2))};
- _ ->
- {Cases,update_status(failed, group_result, GrName,
- delete_status(Ref, Status2))}
- end;
- {value,{_,GroupResult}} ->
- {Cases,update_status(GroupResult, group_result, GrName,
- delete_status(Ref, Status2))};
- false ->
- {Cases,update_status(ok, group_result, GrName,
- delete_status(Ref, Status2))}
- end,
- print_conf_time(ConfTime),
- ReportRepeatStop(),
- set_io_buffering(IOHandler),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, tl(Config), TimetrapData,
- Mode, Status3)
- end;
-
-run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
- Mode, Status) ->
- case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
- {_,Why={'EXIT',_},_} ->
- print(minor, "~n*** ~w failed.~n"
- " Skipping all cases.", [Func]),
- Reason = {failed,{Mod,Func,Why}},
- Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
- auto_skip_case),
- stop_minor_log_file(),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
- {_,_Whatever,_} ->
- stop_minor_log_file(),
- run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status)
- end;
-
-run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
- Config, _TimetrapData, _Mode, _Status) ->
- erlang:error(badarg, [Conf,Config]);
-
-run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
- ActualCfg =
- case get(test_server_create_priv_dir) of
- auto_per_run ->
- update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
- {data_dir,get_data_dir(Mod)}]);
- _ ->
- update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
- end,
- run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
- TimetrapData, Mode, Status);
-
-run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) ->
- {Num,RunInit} =
- case FwMod = get_fw_mod(?MODULE) of
- Mod when Func == error_in_suite ->
- {-1,skip_init};
- _ ->
- {put(test_server_case_num, get(test_server_case_num)+1),
- run_init}
- end,
-
- %% check the current execution mode and save info about the case if
- %% detected that printouts to common log files is handled later
-
- case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
- true ->
- %% sequential test case nested in a parallel group;
- %% io is buffered, so we must queue this test case
- queue_test_case_io(undefined, self(), Num+1, Mod, Func);
- false ->
- ok
- end,
-
- case run_test_case(undefined, Num+1, Mod, Func, Args,
- RunInit, TimetrapData, Mode) of
- %% callback to framework module failed, exit immediately
- {_,{framework_error,{FwMod,FwFunc},Reason},_} ->
- print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
- [FwMod,FwFunc,Reason]),
- print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
- stop_minor_log_file(),
- exit(framework_error);
- %% sequential execution of test case finished
- {Time,RetVal,_} ->
- {Failed,Status1} =
- case Time of
- died ->
- {true,update_status(failed, Mod, Func, Status)};
- _ when is_tuple(RetVal) ->
- case element(1, RetVal) of
- R when R=='EXIT'; R==failed ->
- {true,update_status(failed, Mod, Func, Status)};
- R when R==skip; R==skipped ->
- {false,update_status(skipped, Mod, Func, Status)};
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end;
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end,
- case check_prop(sequence, Mode) of
- false ->
- stop_minor_log_file(),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
- Ref ->
- %% the case is in a sequence; we must check the result and
- %% determine if the following cases should run or be skipped
- if not Failed -> % proceed with next case
- stop_minor_log_file(),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
- true -> % skip rest of cases in sequence
- print(minor, "~n*** ~w failed.~n"
- " Skipping all other cases in sequence.",
- [Func]),
- Reason = {failed,{Mod,Func}},
- Cases2 = skip_cases_upto(Ref, Cases, Reason, tc,
- Mode, auto_skip_case),
- stop_minor_log_file(),
- run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1)
- end
- end;
- %% the test case is being executed in parallel with the main process (and
- %% other test cases) and Pid is the dedicated process executing the case
- Pid ->
- %% io from Pid will be buffered by the test_server_io process and
- %% handled later, so we have to save info about the case
- queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
- run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status)
- end;
-
-%% TestSpec processing finished
-run_test_cases_loop([], _Config, _TimetrapData, _, _) ->
- ok.
-
-%%--------------------------------------------------------------------
-%% various help functions
-
-new_status(Ref, Status) ->
- [{Ref,{{[],[],[]},[]}} | Status].
-
-new_status(Ref, CopiedCases, Status) ->
- [{Ref,{{[],[],[]},CopiedCases}} | Status].
-
-delete_status(Ref, Status) ->
- lists:keydelete(Ref, 1, Status).
-
-update_status(ok, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
- [{Ref,{{Ok++[{Mod,Func}],Skip,Fail},Cs}} | Status];
-
-update_status(skipped, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
- [{Ref,{{Ok,Skip++[{Mod,Func}],Fail},Cs}} | Status];
-
-update_status(failed, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
- [{Ref,{{Ok,Skip,Fail++[{Mod,Func}]},Cs}} | Status];
-
-update_status(_, _, _, []) ->
- [].
-
-update_status(Ref, {Ok,Skip,Fail}, [{Ref,{{Ok0,Skip0,Fail0},Cs}} | Status]) ->
- [{Ref,{{Ok0++Ok,Skip0++Skip,Fail0++Fail},Cs}} | Status].
-
-get_copied_cases([{_,{_,Cases}} | _Status]) ->
- Cases.
-
-get_tc_results([{_,{OkSkipFail,_}} | _Status]) ->
- OkSkipFail;
-get_tc_results([]) -> % in case init_per_suite crashed
- {[],[],[]}.
-
-conf(Ref, Props) ->
- {Ref,Props,?now}.
-
-curr_ref([{Ref,_Props,_}|_]) ->
- Ref;
-curr_ref([]) ->
- undefined.
-
-curr_mode(Ref, Mode0, Mode1) ->
- case curr_ref(Mode1) of
- Ref -> Mode1;
- _ -> Mode0
- end.
-
-get_props([{_,Props,_} | _]) ->
- Props;
-get_props([]) ->
- [].
-
-check_prop(_Attrib, []) ->
- false;
-check_prop(Attrib, [{Ref,Props,_}|_]) ->
- case lists:member(Attrib, Props) of
- true -> Ref;
- false -> false
- end.
-
-check_props(Attrib, Mode) ->
- case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of
- [] -> false;
- [Ref|_] -> Ref
- end.
-
-get_name(Mode, Def) ->
- case get_name(Mode) of
- undefined -> Def;
- Name -> Name
- end.
-
-get_name([{_Ref,Props,_}|_]) ->
- proplists:get_value(name, Props);
-get_name([]) ->
- undefined.
-
-conf_start(Ref, Mode) ->
- case lists:keysearch(Ref, 1, Mode) of
- {value,{_,_,T}} -> T;
- false -> 0
- end.
-
-
-get_data_dir(Mod) ->
- get_data_dir(Mod, undefined).
-
-get_data_dir(Mod, Suite) ->
- UseMod = if Suite == undefined -> Mod;
- true -> Suite
- end,
- case code:which(UseMod) of
- non_existing ->
- print(12, "The module ~w is not loaded", [Mod]),
- [];
- cover_compiled ->
- MainCoverNode = cover:get_main_node(),
- {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
- do_get_data_dir(UseMod,File);
- FullPath ->
- do_get_data_dir(UseMod,FullPath)
- end.
-
-do_get_data_dir(Mod,File) ->
- filename:dirname(File) ++ "/" ++ atom_to_list(Mod) ++ ?data_dir_suffix.
-
-print_conf_time(0) ->
- ok;
-print_conf_time(ConfTime) ->
- print(major, "=group_time ~.3fs", [ConfTime]),
- print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).
-
-print_props([]) ->
- ok;
-print_props(Props) ->
- print(major, "=group_props ~p", [Props]),
- print(minor, "Group properties: ~p~n", [Props]).
-
-%% repeat N times: {repeat,N}
-%% repeat N times or until all successful: {repeat_until_all_ok,N}
-%% repeat N times or until at least one successful: {repeat_until_any_ok,N}
-%% repeat N times or until at least one case fails: {repeat_until_any_fail,N}
-%% repeat N times or until all fails: {repeat_until_all_fail,N}
-%% N = integer() | forever
-get_repeat(Props) ->
- get_prop([repeat,repeat_until_all_ok,repeat_until_any_ok,
- repeat_until_any_fail,repeat_until_all_fail], forever, Props).
-
-update_repeat(Props) ->
- case get_repeat(Props) of
- undefined ->
- Props;
- {RepType,N} ->
- Props1 =
- if N == forever ->
- [{RepType,N}|lists:keydelete(RepType, 1, Props)];
- N < 3 ->
- lists:keydelete(RepType, 1, Props);
- N >= 3 ->
- [{RepType,N-1}|lists:keydelete(RepType, 1, Props)]
- end,
- %% if shuffle is used in combination with repeat, a new
- %% seed shouldn't be set every new turn
- case get_shuffle(Props1) of
- undefined ->
- Props1;
- _ ->
- [{shuffle,repeated}|delete_shuffle(Props1)]
- end
- end.
-
-get_shuffle(Props) ->
- get_prop([shuffle], ?now, Props).
-
-delete_shuffle(Props) ->
- delete_prop([shuffle], Props).
-
-%% Return {Item,Value} if found, else if Item alone
-%% is found, return {Item,Default}
-get_prop([Item|Items], Default, Props) ->
- case lists:keysearch(Item, 1, Props) of
- {value,R} ->
- R;
- false ->
- case lists:member(Item, Props) of
- true ->
- {Item,Default};
- false ->
- get_prop(Items, Default, Props)
- end
- end;
-get_prop([], _Def, _Props) ->
- undefined.
-
-delete_prop([Item|Items], Props) ->
- Props1 = lists:delete(Item, lists:keydelete(Item, 1, Props)),
- delete_prop(Items, Props1);
-delete_prop([], Props) ->
- Props.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% shuffle_cases(Ref, Cases, Seed) -> Cases1
-%%
-%% Shuffles the order of Cases.
-
-shuffle_cases(Ref, Cases, undefined) ->
- shuffle_cases(Ref, Cases, ?now);
-
-shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed) ->
- {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
- ShuffledCases = random_order(N, random:uniform_s(N, Seed), CasesToShuffle, []),
- [Start|ShuffledCases] ++ Rest.
-
-cases_to_shuffle(Ref, Cases) ->
- cases_to_shuffle(Ref, Cases, 1, []).
-
-cases_to_shuffle(Ref, [{conf,Ref,_,_} | _]=Cs, N, Ix) -> % end
- {N-1,Ix,Cs};
-cases_to_shuffle(Ref, [{skip_case,{_,Ref,_,_},_} | _]=Cs, N, Ix) -> % end
- {N-1,Ix,Cs};
-
-cases_to_shuffle(Ref, [{conf,Ref1,_,_}=C | Cs], N, Ix) -> % nested group
- {Cs1,Rest} = get_subcases(Ref1, Cs, []),
- cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
-cases_to_shuffle(Ref, [{skip_case,{_,Ref1,_,_},_}=C | Cs], N, Ix) -> % nested group
- {Cs1,Rest} = get_subcases(Ref1, Cs, []),
- cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
-
-cases_to_shuffle(Ref, [C | Cs], N, Ix) ->
- cases_to_shuffle(Ref, Cs, N+1, [{N,[C]} | Ix]).
-
-get_subcases(SubRef, [{conf,SubRef,_,_}=C | Cs], SubCs) ->
- {lists:reverse([C|SubCs]),Cs};
-get_subcases(SubRef, [{skip_case,{_,SubRef,_,_},_}=C | Cs], SubCs) ->
- {lists:reverse([C|SubCs]),Cs};
-get_subcases(SubRef, [C|Cs], SubCs) ->
- get_subcases(SubRef, Cs, [C|SubCs]).
-
-random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
- %% save current seed to be used if test cases are repeated
- put(test_server_curr_random_seed, Seed),
- Shuffled++CaseOrGroup;
-random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
- {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
- random_order(N-1, random:uniform_s(N-1, NewSeed),
- First++Rest, Shuffled++CaseOrGroup).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func}
-%%
-%% Prints info about a skipped case in the major and html log files.
-%% SendSync determines if start and finished messages must be sent so
-%% that the printouts can be buffered and handled in order with io from
-%% parallel processes.
-skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) ->
- MF = {Mod,Func} = case Case of
- {M,F,_A} -> {M,F};
- {M,F} -> {M,F}
- end,
- if SendSync ->
- queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
- self() ! {started,Ref,self(),CaseNum,Mod,Func},
- test_server_io:start_transaction(),
- skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
- test_server_io:end_transaction(),
- self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
- not SendSync ->
- skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
- end,
- MF.
-
-skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
- {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode),
- ResultCol = if Type == auto -> ?auto_skip_color;
- Type == user -> ?user_skip_color
- end,
- print(major, "~n=case ~w:~w", [Mod,Func]),
- GroupName = case get_name(Mode) of
- undefined ->
- "";
- GrName ->
- GrName1 = cast_to_list(GrName),
- print(major, "=group_props ~p", [[{name,GrName1}]]),
- GrName1
- end,
- print(major, "=started ~s", [lists:flatten(timestamp_get(""))]),
- Comment1 = reason_to_string(Comment),
- if Type == auto ->
- print(major, "=result auto_skipped: ~ts", [Comment1]);
- Type == user ->
- print(major, "=result skipped: ~ts", [Comment1])
- end,
- if CaseNum == 0 ->
- print(2,"*** Skipping ~w ***", [{Mod,Func}]);
- true ->
- print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}])
- end,
- TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
- GroupName = case get_name(Mode) of
- undefined -> "";
- Name -> cast_to_list(Name)
- end,
- print(html,
- TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>"
- "<td><font color=\"~ts\">SKIPPED</font></td>"
- "<td>~ts</td></tr>\n",
- [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]),
-
- if CaseNum > 0 ->
- {US,AS} = get(test_server_skipped),
- case Type of
- user -> put(test_server_skipped, {US+1,AS});
- auto -> put(test_server_skipped, {US,AS+1})
- end,
- put(test_server_case_num, CaseNum);
- true -> % conf
- ok
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> Cases1
-%%
-%% SkipType = skip_case | auto_skip_case
-%% Mark all cases tagged with Ref as skipped.
-
-skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) ->
- {_,Modified,Rest} =
- modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases),
- Modified++Rest.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% copy_cases(OrigRef, NewRef, Cases) -> Cases1
-%%
-%% Copy the test cases marked with OrigRef and tag the copies with NewRef.
-%% The start conf case copy will also get its repeat property updated.
-
-copy_cases(OrigRef, NewRef, Cases) ->
- {Original,Altered,Rest} = modify_cases_upto(OrigRef, {copy,NewRef}, Cases),
- {Altered,Original++Altered++Rest}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% modify_cases_upto(Ref, ModOp, Cases) -> {Original,Altered,Remaining}
-%%
-%% ModOp = {skip,Reason,Origin,Mode} | {copy,NewRef}
-%% Origin = conf | tc
-%%
-%% Modifies Cases according to ModOp and returns the original elements,
-%% the modified versions of these elements and the remaining (untouched)
-%% cases.
-
-modify_cases_upto(Ref, ModOp, Cases) ->
- {Original,Altered,Rest} = modify_cases_upto(Ref, ModOp, Cases, [], []),
- {lists:reverse(Original),lists:reverse(Altered),Rest}.
-
-%% first case of a copy operation is the start conf
-modify_cases_upto(Ref, {copy,NewRef}=Op, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
- modify_cases_upto(Ref, Op, T, [C|Orig], [{conf,NewRef,update_repeat(Props),MF}|Alt]);
-
-modify_cases_upto(Ref, ModOp, Cases, Orig, Alt) ->
- %% we need to check if there's an end conf case with the
- %% same ref in the list, if not, this *is* an end conf case
- case lists:any(fun({_,R,_,_}) when R == Ref -> true;
- ({_,R,_}) when R == Ref -> true;
- ({skip_case,{_,R,_,_},_}) when R == Ref -> true;
- ({skip_case,{_,R,_,_}}) when R == Ref -> true;
- (_) -> false
- end, Cases) of
- true ->
- modify_cases_upto1(Ref, ModOp, Cases, Orig, Alt);
- false ->
- {[],[],Cases}
- end.
-
-%% next case is a conf with same ref, must be end conf = we're done
-modify_cases_upto1(Ref, {skip,Reason,conf,Mode,skip_case},
- [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
- {Orig,[{skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
-modify_cases_upto1(Ref, {skip,Reason,conf,Mode,auto_skip_case},
- [{conf,Ref,_Props,MF}|T], Orig, Alt) ->
- {Orig,[{auto_skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T};
-modify_cases_upto1(Ref, {copy,NewRef}, [{conf,Ref,Props,MF}=C|T], Orig, Alt) ->
- {[C|Orig],[{conf,NewRef,update_repeat(Props),MF}|Alt],T};
-
-%% we've skipped all remaining cases in a sequence
-modify_cases_upto1(Ref, {skip,_,tc,_,_},
- [{conf,Ref,_Props,_MF}|_]=Cs, Orig, Alt) ->
- {Orig,Alt,Cs};
-
-%% next is a make case
-modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
- [{make,Ref,MF}|T], Orig, Alt) ->
- {Orig,[{SkipType,{make,Ref,MF,Reason},Mode}|Alt],T};
-modify_cases_upto1(Ref, {copy,NewRef}, [{make,Ref,MF}=M|T], Orig, Alt) ->
- {[M|Orig],[{make,NewRef,MF}|Alt],T};
-
-%% next case is a user skipped end conf with the same ref = we're done
-modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
- [{skip_case,{Type,Ref,MF,_Cmt},_}|T], Orig, Alt) ->
- {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
-modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType},
- [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) ->
- {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T};
-modify_cases_upto1(Ref, {copy,NewRef},
- [{skip_case,{Type,Ref,MF,Cmt},Mode}=C|T], Orig, Alt) ->
- {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt},Mode}|Alt],T};
-modify_cases_upto1(Ref, {copy,NewRef},
- [{skip_case,{Type,Ref,MF,Cmt}}=C|T], Orig, Alt) ->
- {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt}}|Alt],T};
-
-%% next is a skip_case, could be one test case or 'all' in suite, we must proceed
-modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt},_Mode}=MF|T], Orig, Alt) ->
- modify_cases_upto1(Ref, ModOp, T, [MF|Orig], [MF|Alt]);
-
-%% next is a normal case (possibly in a sequence), mark as skipped, or copy, and proceed
-modify_cases_upto1(Ref, {skip,Reason,_,Mode,skip_case}=Op,
- [{_M,_F}=MF|T], Orig, Alt) ->
- modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason},Mode}|Alt]);
-modify_cases_upto1(Ref, {skip,Reason,_,Mode,auto_skip_case}=Op,
- [{_M,_F}=MF|T], Orig, Alt) ->
- modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]);
-modify_cases_upto1(Ref, CopyOp, [{_M,_F}=MF|T], Orig, Alt) ->
- modify_cases_upto1(Ref, CopyOp, T, [MF|Orig], [MF|Alt]);
-
-%% next is a conf case, modify the Mode arg to keep track of sub groups
-modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType},
- [{conf,OtherRef,Props,_MF}|T], Orig, Alt) ->
- case hd(Mode) of
- {OtherRef,_,_} -> % end conf
- modify_cases_upto1(Ref, {skip,Reason,FType,tl(Mode),SkipType},
- T, Orig, Alt);
- _ -> % start conf
- Mode1 = [conf(OtherRef,Props)|Mode],
- modify_cases_upto1(Ref, {skip,Reason,FType,Mode1,SkipType},
- T, Orig, Alt)
- end;
-
-%% next is some other case, ignore or copy
-modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_Other|T], Orig, Alt) ->
- modify_cases_upto1(Ref, Op, T, Orig, Alt);
-modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) ->
- modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% set_io_buffering(IOHandler) -> PrevIOHandler
-%%
-%% Save info about current process (always the main process) buffering
-%% io printout messages from parallel test case processes (*and* possibly
-%% also the main process).
-
-set_io_buffering(IOHandler) ->
- put(test_server_common_io_handler, IOHandler).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_io_buffered() -> true|false
-%%
-%% Test whether is being buffered.
-
-is_io_buffered() ->
- get(test_server_common_io_handler) =/= undefined.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% queue_test_case_io(Pid, Num, Mod, Func) -> ok
-%%
-%% Save info about test case that gets its io buffered. This can
-%% be a parallel test case or it can be a test case (conf or normal)
-%% that belongs to a group nested under a parallel group. The queue
-%% is processed after io buffering is disabled. See run_test_cases_loop/4
-%% and handle_test_case_io_and_status/0 for more info.
-
-queue_test_case_io(Ref, Pid, Num, Mod, Func) ->
- Entry = {Ref,Pid,Num,Mod,Func},
- %% the order of the test cases is very important!
- put(test_server_queued_io,
- get(test_server_queued_io)++[Entry]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% wait_for_cases(Ref) -> {Ok,Skipped,Failed}
-%%
-%% At the end of a nested parallel group, we have to wait for the test
-%% cases to terminate before we can go on (since test cases never execute
-%% in parallel with the end conf case of the group). When a top level
-%% parallel group is finished, buffered io messages must be handled and
-%% this is taken care of by handle_test_case_io_and_status/0.
-
-wait_for_cases(Ref) ->
- case get(test_server_queued_io) of
- [] ->
- {[],[],[]};
- Cases ->
- [_Start|TCs] =
- lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false;
- (_) -> true
- end, Cases),
- wait_and_resend(Ref, TCs, [],[],[])
- end.
-
-wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps],
- Ok,Skip,Fail) when is_reference(OtherRef),
- OtherRef /= Ref ->
- %% ignore cases that belong to nested group
- Ps1 = rm_cases_upto(OtherRef, Ps),
- wait_and_resend(Ref, Ps1, Ok,Skip,Fail);
-
-wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
- receive
- {finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg ->
- %% resend message to main process so that it can be used
- %% to test_server_io:print_buffered/1 later
- self() ! Msg,
- MF = {Mod,Func},
- {Ok1,Skip1,Fail1} =
- case Result of
- ok -> {[MF|Ok],Skip,Fail};
- skipped -> {Ok,[MF|Skip],Fail};
- failed -> {Ok,Skip,[MF|Fail]}
- end,
- wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1);
- {'EXIT',CurrPid,Reason} when Reason /= normal ->
- %% unexpected termination of test case process
- {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases),
- print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
- [CaseNum, Mod, Func, Reason]),
- exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}})
- end;
-
-wait_and_resend(_, [], Ok,Skip,Fail) ->
- {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.
-
-rm_cases_upto(Ref, [{Ref,_,0,_,_}|Ps]) ->
- Ps;
-rm_cases_upto(Ref, [_|Ps]) ->
- rm_cases_upto(Ref, Ps).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_test_case_io_and_status() -> [Ok,Skipped,Failed}
-%%
-%% Each parallel test case process prints to its own minor log file during
-%% execution. The common log files (major, html etc) must however be
-%% written to sequentially. This is handled by calling
-%% test_server_io:start_transaction/0 to tell the test_server_io process
-%% to buffer all print requests.
-%%
-%% An io session is always started with a
-%% {started,Ref,Pid,Num,Mod,Func} message (and
-%% test_server_io:start_transaction/0 will be called) and terminated
-%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and
-%% test_server_io:end_transaction/0 will be called). The result
-%% shipped with the finished message from a parallel process is used
-%% to update status data of the current test run. An 'EXIT' message
-%% from each parallel test case process (after finishing and
-%% terminating) is also received and handled here.
-%%
-%% During execution of a parallel group, any cases (conf or normal)
-%% belonging to a nested group will also get its io printouts buffered.
-%% This is necessary to get the major and html log files written in
-%% correct sequence. This function handles also the print messages
-%% generated by nested group cases that have been executed sequentially
-%% by the main process (note that these cases do not generate 'EXIT'
-%% messages, only 'start' and 'finished' messages).
-%%
-%% See the header comment for run_test_cases_loop/4 for more
-%% info about IO handling.
-%%
-%% Note: It is important that the type of messages handled here
-%% do not get consumed by test_server:run_test_case_msgloop/5
-%% during the test case execution (e.g. in the catch clause of
-%% the receive)!
-
-handle_test_case_io_and_status() ->
- case get(test_server_queued_io) of
- [] ->
- {[],[],[]};
- Cases ->
- %% Cases = [{Ref,Pid,CaseNum,Mod,Func} | ...]
- Result = handle_io_and_exit_loop([], Cases, [],[],[]),
- Main = self(),
- %% flush normal exit messages
- lists:foreach(fun({_,Pid,_,_,_}) when Pid /= Main ->
- receive
- {'EXIT',Pid,normal} -> ok
- after
- 1000 -> ok
- end;
- (_) ->
- ok
- end, Cases),
- Result
- end.
-
-%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = [])
-handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
- %% retrieve the start message for the current io session (= testcase)
- receive
- {started,_,CurrPid,CaseNum,Mod,Func} ->
- {Ok1,Skip1,Fail1} =
- case handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases) of
- {ok,MF} -> {[MF|Ok],Skip,Fail};
- {skipped,MF} -> {Ok,[MF|Skip],Fail};
- {failed,MF} -> {Ok,Skip,[MF|Fail]}
- end,
- handle_io_and_exit_loop([], Ps, Ok1,Skip1,Fail1)
- after
- 1000 ->
- exit({testcase_failed_to_start,Mod,Func})
- end;
-
-%% Handle cases that belong to groups nested under top parallel group
-handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
- receive
- {started,_,CurrPid,CaseNum,Mod,Func} ->
- handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases),
- Refs1 =
- case Refs of
- [Ref|Rs] -> % must be end conf case for subgroup
- Rs;
- _ when is_reference(Ref) -> % must be start of new subgroup
- [Ref|Refs];
- _ -> % must be normal subgroup testcase
- Refs
- end,
- handle_io_and_exit_loop(Refs1, Ps, Ok,Skip,Fail)
- after
- 1000 ->
- exit({testcase_failed_to_start,Mod,Func})
- end;
-
-handle_io_and_exit_loop(_, [], Ok,Skip,Fail) ->
- {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}.
-
-handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
- receive
- {abort_current_testcase=Tag,_Reason,From} ->
- %% If a parallel group is executing, there is no unique
- %% current test case, so we must generate an error.
- From ! {self(),Tag,{error,parallel_group}},
- handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases);
- %% end of io session from test case executed by main process
- {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} ->
- test_server_io:print_buffered(CurrPid),
- {Result,{Mod,Func}};
- %% end of io session from test case executed by parallel process
- {finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} ->
- test_server_io:print_buffered(CurrPid),
- case Result of
- ok ->
- put(test_server_ok, get(test_server_ok)+1);
- failed ->
- put(test_server_failed, get(test_server_failed)+1);
- skipped ->
- SkipCounters =
- update_skip_counters(RetVal, get(test_server_skipped)),
- put(test_server_skipped, SkipCounters)
- end,
- {Result,{Mod,Func}};
-
- %% unexpected termination of test case process
- {'EXIT',TCPid,Reason} when Reason /= normal ->
- test_server_io:print_buffered(CurrPid),
- {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases),
- print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
- [Num, M, F, Reason]),
- exit({unexpected_termination,{Num,M,F},{TCPid,Reason}})
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_case(Ref, Num, Mod, Func, Args, RunInit,
-%% TimetrapData, Mode) -> RetVal
-%%
-%% Creates the minor log file and inserts some test case specific headers
-%% and footers into the log files. Then the test case is executed and the
-%% result is printed to the log files (also info about lingering processes
-%% & slave nodes in the system is presented).
-%%
-%% RunInit decides if the per test case init is to be run (true for all
-%% but conf cases).
-%%
-%% Mode specifies if the test case should be executed by a dedicated,
-%% parallel, process rather than sequentially by the main process. If
-%% the former, the new process is spawned and the dictionary of the main
-%% process is copied to the test case process.
-%%
-%% RetVal is the result of executing the test case. It contains info
-%% about the execution time and the return value of the test case function.
-
-run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) ->
- file:set_cwd(filename:dirname(get(test_server_dir))),
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
- TimetrapData, [], self()).
-
-run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) ->
- %% a conf case is always executed by the main process
- run_test_case1(Ref, Num, Mod, Func, Args, skip_init,
- TimetrapData, Mode, self());
-
-run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) ->
- file:set_cwd(filename:dirname(get(test_server_dir))),
- Main = self(),
- case check_prop(parallel, Mode) of
- false ->
- %% this is a sequential test case
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
- TimetrapData, Mode, Main);
- _Ref ->
- %% this a parallel test case, spawn the new process
- Dictionary = get(),
- {dictionary,Dictionary} = process_info(self(), dictionary),
- spawn_link(
- fun() ->
- process_flag(trap_exit, true),
- [put(Key, Val) || {Key,Val} <- Dictionary],
- set_io_buffering({tc,Main}),
- run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
- TimetrapData, Mode, Main)
- end)
- end.
-
-run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
- TimetrapData, Mode, Main) ->
- group_leader(test_server_io:get_gl(Main == self()), self()),
-
- %% if io is being buffered, send start io session message
- %% (no matter if case runs on parallel or main process)
- case is_io_buffered() of
- false -> ok;
- true ->
- test_server_io:start_transaction(),
- Main ! {started,Ref,self(),Num,Mod,Func}
- end,
- TSDir = get(test_server_dir),
-
- print(major, "=case ~w:~w", [Mod, Func]),
- MinorName = start_minor_log_file(Mod, Func, self() /= Main),
- MinorBase = filename:basename(MinorName),
- print(major, "=logfile ~ts", [filename:basename(MinorName)]),
-
- UpdatedArgs =
- %% maybe create unique private directory for test case or config func
- case get(test_server_create_priv_dir) of
- auto_per_run ->
- update_config(hd(Args), [{tc_logfile,MinorName}]);
- PrivDirMode ->
- %% create unique private directory for test case
- RunDir = filename:dirname(MinorName),
- Ext =
- if Num == 0 ->
- Int = erlang:unique_integer([positive,monotonic]),
- lists:flatten(io_lib:format(".cfg.~w", [Int]));
- true ->
- lists:flatten(io_lib:format(".~w", [Num]))
- end,
- PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext,
- if PrivDirMode == auto_per_tc ->
- ok = file:make_dir(PrivDir);
- PrivDirMode == manual_per_tc ->
- ok
- end,
- update_config(hd(Args), [{priv_dir,PrivDir++"/"},
- {tc_logfile,MinorName}])
- end,
- GrName = get_name(Mode),
- test_server_sup:framework_call(report,
- [tc_start,{{Mod,{Func,GrName}},
- MinorName}]),
-
- {ok,Cwd} = file:get_cwd(),
- Args2Print = if is_list(UpdatedArgs) ->
- lists:keydelete(tc_group_result, 1, UpdatedArgs);
- true ->
- UpdatedArgs
- end,
- if RunInit == skip_init ->
- print_props(get_props(Mode));
- true ->
- ok
- end,
- print(minor, "Config value:\n\n ~tp\n", [Args2Print]),
- print(minor, "Current directory is ~tp\n", [Cwd]),
-
- GrNameStr = case GrName of
- undefined -> "";
- Name -> cast_to_list(Name)
- end,
- print(major, "=started ~s", [lists:flatten(timestamp_get(""))]),
- {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode),
- TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
- EncMinorBase = uri_encode(MinorBase),
- print(html, TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td><a href=\"~ts\">~w</a></td>"
- "<td><a href=\"~ts#top\"><</a> <a href=\"~ts#end\">></a></td>",
- [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func,
- EncMinorBase,EncMinorBase]),
-
- do_unless_parallel(Main, fun erlang:yield/0),
-
- %% run the test case
- {Result,DetectedFail,ProcsBefore,ProcsAfter} =
- run_test_case_apply(Num, Mod, Func, [UpdatedArgs], GrName,
- RunInit, TimetrapData),
- {Time,RetVal,Loc,Opts,Comment} =
- case Result of
- Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal;
- {died,DReason,DLoc,DCmt} -> {died,DReason,DLoc,[],DCmt}
- end,
-
- print(minor, "<a name=\"end\"></a>", [], internal_raw),
- print(minor, "\n", [], internal_raw),
- print_timestamp(minor, "Ended at "),
- print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]),
-
- do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end),
-
- %% call the appropriate progress function clause to print the results to log
- Status =
- case {Time,RetVal} of
- {died,{timetrap_timeout,TimetrapTimeout}} ->
- progress(failed, Num, Mod, Func, GrName, Loc,
- timetrap_timeout, TimetrapTimeout, Comment, Style);
- {died,Reason} ->
- progress(failed, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
- Skip==auto_skip ->
- progress(skip, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped ->
- progress(skip, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{'EXIT',_Pid,Reason}} ->
- progress(failed, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{'EXIT',Reason}} ->
- progress(failed, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed ->
- progress(failed, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,Reason={auto_skip,_Why}} ->
- progress(skip, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {_,{Skip,Reason}} when Skip==skip; Skip==skipped ->
- progress(skip, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style);
- {Time,RetVal} ->
- case DetectedFail of
- [] ->
- progress(ok, Num, Mod, Func, GrName, Loc, RetVal,
- Time, Comment, Style);
-
- Reason ->
- progress(failed, Num, Mod, Func, GrName, Loc, Reason,
- Time, Comment, Style)
- end
- end,
- %% if the test case was executed sequentially, this updates the
- %% status count on the main process (status of parallel test cases
- %% is updated later by the handle_test_case_io_and_status/0 function)
- case {RunInit,Status} of
- {skip_init,_} -> % conf doesn't count
- ok;
- {_,ok} ->
- put(test_server_ok, get(test_server_ok)+1);
- {_,failed} ->
- put(test_server_failed, get(test_server_failed)+1);
- {_,skip} ->
- {US,AS} = get(test_server_skipped),
- put(test_server_skipped, {US+1,AS});
- {_,auto_skip} ->
- {US,AS} = get(test_server_skipped),
- put(test_server_skipped, {US,AS+1})
- end,
- %% only if test case execution is sequential do we care about the
- %% remaining processes and slave nodes count
- case self() of
- Main ->
- case test_server_sup:framework_call(warn, [processes], true) of
- true ->
- if ProcsBefore < ProcsAfter ->
- print(minor,
- "WARNING: ~w more processes in system after test case",
- [ProcsAfter-ProcsBefore]);
- ProcsBefore > ProcsAfter ->
- print(minor,
- "WARNING: ~w less processes in system after test case",
- [ProcsBefore-ProcsAfter]);
- true -> ok
- end;
- false ->
- ok
- end,
- case test_server_sup:framework_call(warn, [nodes], true) of
- true ->
- case catch controller_call(kill_slavenodes) of
- {'EXIT',_} = Exit ->
- print(minor,
- "WARNING: There might be slavenodes left in the"
- " system. I tried to kill them, but I failed: ~p\n",
- [Exit]);
- [] -> ok;
- List ->
- print(minor, "WARNING: ~w slave nodes in system after test"++
- "case. Tried to killed them.~n"++
- " Names:~p",
- [length(List),List])
- end;
- false ->
- ok
- end;
- _ ->
- ok
- end,
- %% if the test case was executed sequentially, this updates the execution
- %% time count on the main process (adding execution time of parallel test
- %% case groups is done in run_test_cases_loop/4)
- if is_number(Time) ->
- put(test_server_total_time, get(test_server_total_time)+Time);
- true ->
- ok
- end,
- test_server_sup:check_new_crash_dumps(),
-
- %% if io is being buffered, send finished message
- %% (no matter if case runs on parallel or main process)
- case is_io_buffered() of
- false ->
- ok;
- true ->
- test_server_io:end_transaction(),
- Main ! {finished,Ref,self(),Num,Mod,Func,
- ?mod_result(Status),{Time,RetVal,Opts}}
- end,
- {Time,RetVal,Opts}.
-
-
-%%--------------------------------------------------------------------
-%% various help functions
-
-%% Call Action if we are running on the main process (not parallel).
-do_unless_parallel(Main, Action) when is_function(Action, 0) ->
- case self() of
- Main -> Action();
- _ -> ok
- end.
-
-num2str(0) -> "";
-num2str(N) -> integer_to_list(N).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time,
-%% Comment, TimeFormat) -> Result
-%%
-%% Prints the result of the test case to log file.
-%% Note: Strings that are to be written to the minor log must
-%% be prefixed with "=== " here, or the indentation will be wrong.
-
-progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
- Comment, {St0,St1}) ->
- {Reason1,{Color,Ret,ReportTag}} =
- if_auto_skip(Reason,
- fun() -> {?auto_skip_color,auto_skip,auto_skipped} end,
- fun() -> {?user_skip_color,skip,skipped} end),
- print(major, "=result ~w: ~p", [ReportTag,Reason1]),
- print(1, "*** SKIPPED ~ts ***",
- [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
- test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
- {ReportTag,Reason1}}]),
- ReasonStr = reason_to_string(Reason1),
- ReasonStr1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(ReasonStr,[$\n])]),
- ReasonStr2 =
- if length(ReasonStr1) > 80 ->
- string:substr(ReasonStr1, 1, 77) ++ "...";
- true ->
- ReasonStr1
- end,
- Comment1 = case Comment of
- "" -> "";
- _ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")"
- end,
- print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
- "<td><font color=\"~ts\">SKIPPED</font></td>"
- "<td>~ts~ts</td></tr>\n",
- [Time,Color,ReasonStr2,Comment1]),
- FormatLoc = test_server_sup:format_loc(Loc),
- print(minor, "=== Location: ~ts", [FormatLoc]),
- print(minor, "=== Reason: ~ts", [ReasonStr1]),
- Ret;
-
-progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T,
- Comment0, {St0,St1}) ->
- print(major, "=result failed: timeout, ~p", [Loc]),
- print(1, "*** FAILED ~ts ***",
- [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
- test_server_sup:framework_call(report,
- [tc_done,{Mod,{Func,GrName},
- {failed,timetrap_timeout}}]),
- FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
- ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]),
- Comment =
- case Comment0 of
- "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
- _ -> "<font color=\"red\">" ++ ErrorReason ++
- xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
- end,
- print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
- "<td><font color=\"red\">FAILED</font></td>"
- "<td>~ts</td></tr>\n",
- [T/1000,Comment]),
- FormatLoc = test_server_sup:format_loc(Loc),
- print(minor, "=== Location: ~ts", [FormatLoc]),
- print(minor, "=== Reason: timetrap timeout", []),
- failed;
-
-progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
- Comment0, {St0,St1}) ->
- print(major, "=result failed: testcase_aborted, ~p", [Loc]),
- print(1, "*** FAILED ~ts ***",
- [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
- test_server_sup:framework_call(report,
- [tc_done,{Mod,{Func,GrName},
- {failed,testcase_aborted}}]),
- FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)),
- ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]),
- Comment =
- case Comment0 of
- "" -> "<font color=\"red\">" ++ ErrorReason ++ "</font>";
- _ -> "<font color=\"red\">" ++ ErrorReason ++
- xhtml("</font><br>","</font><br />") ++ to_string(Comment0)
- end,
- print(html,
- "<td>" ++ St0 ++ "died" ++ St1 ++ "</td>"
- "<td><font color=\"red\">FAILED</font></td>"
- "<td>~ts</td></tr>\n",
- [Comment]),
- FormatLoc = test_server_sup:format_loc(Loc),
- print(minor, "=== Location: ~ts", [FormatLoc]),
- print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]),
- failed;
-
-progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
- Comment0, {St0,St1}) ->
- print(major, "=result failed: ~p, ~w", [Reason,unknown_location]),
- print(1, "*** FAILED ~ts ***",
- [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
- test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
- {failed,Reason}}]),
- TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
- true -> "~w"
- end, [Time]),
- ErrorReason = lists:flatten(io_lib:format("~p", [Reason])),
- ErrorReason1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(ErrorReason,[$\n])]),
- ErrorReason2 =
- if length(ErrorReason1) > 63 ->
- string:substr(ErrorReason1, 1, 60) ++ "...";
- true ->
- ErrorReason1
- end,
- Comment =
- case Comment0 of
- "" -> "<font color=\"red\">" ++ ErrorReason2 ++ "</font>";
- _ -> "<font color=\"red\">" ++ ErrorReason2 ++
- xhtml("</font><br>","</font><br />") ++
- to_string(Comment0)
- end,
- print(html,
- "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
- "<td><font color=\"red\">FAILED</font></td>"
- "<td>~ts</td></tr>\n",
- [TimeStr,Comment]),
- print(minor, "=== Location: ~w", [unknown]),
- {FStr,FormattedReason} = format_exception(Reason),
- print(minor, "=== Reason: " ++ FStr, [FormattedReason]),
- failed;
-
-progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
- Comment0, {St0,St1}) ->
- {LocMaj,LocMin} = if Func == error_in_suite ->
- case get_fw_mod(undefined) of
- Mod -> {unknown_location,unknown};
- _ -> {Loc,Loc}
- end;
- true -> {Loc,Loc}
- end,
- print(major, "=result failed: ~p, ~p", [Reason,LocMaj]),
- print(1, "*** FAILED ~ts ***",
- [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
- test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
- {failed,Reason}}]),
- TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
- true -> "~w"
- end, [Time]),
- Comment =
- case Comment0 of
- "" -> "";
- _ -> xhtml("<br>","<br />") ++ to_string(Comment0)
- end,
- FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)),
- print(html,
- "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
- "<td><font color=\"red\">FAILED</font></td>"
- "<td><font color=\"red\">~ts</font>~ts</td></tr>\n",
- [TimeStr,FormatLastLoc,Comment]),
- FormatLoc = test_server_sup:format_loc(LocMin),
- print(minor, "=== Location: ~ts", [FormatLoc]),
- {FStr,FormattedReason} = format_exception(Reason),
- print(minor, "=== Reason: " ++ FStr, [FormattedReason]),
- failed;
-
-progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
- Comment0, {St0,St1}) ->
- print(minor, "successfully completed test case", []),
- test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]),
- Comment =
- case RetVal of
- {comment,RetComment} ->
- String = to_string(RetComment),
- HtmlCmt = test_server_sup:framework_call(format_comment,
- [String],
- String),
- print(major, "=result ok: ~ts", [String]),
- "<td>" ++ HtmlCmt ++ "</td>";
- _ ->
- print(major, "=result ok", []),
- case Comment0 of
- "" -> "<td></td>";
- _ -> "<td>" ++ to_string(Comment0) ++ "</td>"
- end
- end,
- print(major, "=elapsed ~p", [Time]),
- print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
- "<td><font color=\"green\">Ok</font></td>"
- "~ts</tr>\n",
- [Time,Comment]),
- print(minor, "=== Returned value: ~p", [RetVal]),
- ok.
-
-%%--------------------------------------------------------------------
-%% various help functions
-
-get_fw_mod(Mod) ->
- case get(test_server_framework) of
- undefined ->
- case os:getenv("TEST_SERVER_FRAMEWORK") of
- FW when FW =:= false; FW =:= "undefined" ->
- Mod;
- FW ->
- list_to_atom(FW)
- end;
- '$none' -> Mod;
- FW -> FW
- end.
-
-fw_name(?MODULE) ->
- test_server;
-fw_name(Mod) ->
- case get(test_server_framework_name) of
- undefined ->
- case get_fw_mod(undefined) of
- undefined ->
- Mod;
- Mod ->
- case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of
- FWName when FWName =:= false; FWName =:= "undefined" ->
- Mod;
- FWName ->
- list_to_atom(FWName)
- end;
- _ ->
- Mod
- end;
- '$none' ->
- Mod;
- FWName ->
- case get_fw_mod(Mod) of
- Mod -> FWName;
- _ -> Mod
- end
- end.
-
-if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) ->
- {Reason,True()};
-if_auto_skip({skip,Reason={failed,{_,init_per_testcase,_}}}, True, _False) ->
- {Reason,True()};
-if_auto_skip({auto_skip,Reason}, True, _False) ->
- {Reason,True()};
-if_auto_skip(Reason, _True, False) ->
- {Reason,False()}.
-
-update_skip_counters({_T,Pat,_Opts}, {US,AS}) ->
- {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
- Result;
-update_skip_counters(Pat, {US,AS}) ->
- {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end),
- Result.
-
-get_info_str(Mod,Func, 0, _Cases) ->
- io_lib:format("~w", [{Mod,Func}]);
-get_info_str(_Mod,_Func, CaseNum, unknown) ->
- "test case " ++ integer_to_list(CaseNum);
-get_info_str(_Mod,_Func, CaseNum, Cases) ->
- "test case " ++ integer_to_list(CaseNum) ++
- " of " ++ integer_to_list(Cases).
-
-print_if_known(Known, {SK,AK}, {SU,AU}) ->
- {S,A} = if Known == unknown -> {SU,AU};
- true -> {SK,AK}
- end,
- io_lib:format(S, A).
-
-to_string(Term) when is_list(Term) ->
- case (catch io_lib:format("~ts", [Term])) of
- {'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term]));
- String -> lists:flatten(String)
- end;
-to_string(Term) ->
- lists:flatten(io_lib:format("~p", [Term])).
-
-get_last_loc(Loc) when is_tuple(Loc) ->
- Loc;
-get_last_loc([Loc|_]) when is_tuple(Loc) ->
- [Loc];
-get_last_loc(Loc) ->
- Loc.
-
-reason_to_string({failed,{_,FailFunc,bad_return}}) ->
- atom_to_list(FailFunc) ++ " bad return value";
-reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) ->
- atom_to_list(FailFunc) ++ " timed out";
-reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) ->
- to_string(FWInitFail);
-reason_to_string({failed,{_,FailFunc,_}}) ->
- atom_to_list(FailFunc) ++ " failed";
-reason_to_string(Other) ->
- to_string(Other).
-
-%get_font_style(Prop) ->
-% {Col,St0,St1} = get_font_style1(Prop),
-% {{"<font color="++Col++">","</font>"},
-% {"<font color="++Col++">"++St0,St1++"</font>"}}.
-
-get_font_style(NormalCase, Mode) ->
- Prop = if not NormalCase ->
- default;
- true ->
- case check_prop(parallel, Mode) of
- false ->
- case check_prop(sequence, Mode) of
- false ->
- default;
- _ ->
- sequence
- end;
- _ ->
- parallel
- end
- end,
- {Col,St0,St1} = get_font_style1(Prop),
- {{"<font color="++Col++">","</font>"},
- {"<font color="++Col++">"++St0,St1++"</font>"}}.
-
-get_font_style1(parallel) ->
- {"\"darkslategray\"","<i>","</i>"};
-get_font_style1(sequence) ->
-% {"\"darkolivegreen\"","",""};
- {"\"saddlebrown\"","",""};
-get_font_style1(default) ->
- {"\"black\"","",""}.
-%%get_font_style1(skipped) ->
-%% {"\"lightgray\"","",""}.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% format_exception({Error,Stack}) -> {CtrlSeq,Term}
-%%
-%% The default behaviour is that error information gets formatted
-%% (like in the erlang shell) before printed to the minor log file.
-%% The framework application can switch this feature off by setting
-%% *its* application environment variable 'format_exception' to false.
-%% It is also possible to switch formatting off by starting the
-%% test_server node with init argument 'test_server_format_exception'
-%% set to false.
-
-format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
- case get_fw_mod(undefined) of
- undefined ->
- case application:get_env(test_server, format_exception) of
- {ok,false} ->
- {"~p",Reason};
- _ ->
- do_format_exception(Reason)
- end;
- FW ->
- case application:get_env(FW, format_exception) of
- {ok,false} ->
- {"~p",Reason};
- _ ->
- do_format_exception(Reason)
- end
- end;
-format_exception(Error) ->
- format_exception({Error,[]}).
-
-do_format_exception(Reason={Error,Stack}) ->
- StackFun = fun(_, _, _) -> false end,
- PF = fun(Term, I) ->
- io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term])
- end,
- case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of
- {'EXIT',_} ->
- {"~p",Reason};
- Formatted ->
- Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]),
- {"~ts",lists:flatten(Formatted1)}
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
-%% TimetrapData) ->
-%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} |
-%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter}
-%% Name = atom()
-%% Time = float() (seconds)
-%% RetVal = term()
-%% Loc = term()
-%% Comment = string()
-%% Reason = term()
-%% DetectedFail = [{File,Line}]
-%% ProcessesBefore = ProcessesAfter = integer()
-%%
-
-run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit,
- TimetrapData) ->
- test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,
- TimetrapData}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% print(Detail, Format, Args) -> ok
-%% Detail = integer()
-%% Format = string()
-%% Args = [term()]
-%%
-%% Just like io:format, except that depending on the Detail value, the output
-%% is directed to console, major and/or minor log files.
-
-print(Detail, Format) ->
- print(Detail, Format, []).
-
-print(Detail, Format, Args) ->
- print(Detail, Format, Args, internal).
-
-print(Detail, Format, Args, Printer) ->
- Msg = io_lib:format(Format, Args),
- print_or_buffer(Detail, Msg, Printer).
-
-print_or_buffer(Detail, Msg, Printer) ->
- test_server_gl:print(group_leader(), Detail, Msg, Printer).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% print_timestamp(Detail, Leader) -> ok
-%%
-%% Prints Leader followed by a time stamp (date and time). Depending on
-%% the Detail value, the output is directed to console, major and/or minor
-%% log files.
-
-print_timestamp(Detail, Leader) ->
- print(Detail, timestamp_get(Leader), []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% print_who(Host, User) -> ok
-%%
-%% Logs who runs the suite.
-
-print_who(Host, User) ->
- UserStr = case User of
- "" -> "";
- _ -> " by " ++ User
- end,
- print(html, "Run~ts on ~ts", [UserStr,Host]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% format(Format) -> IoLibReturn
-%% format(Detail, Format) -> IoLibReturn
-%% format(Format, Args) -> IoLibReturn
-%% format(Detail, Format, Args) -> IoLibReturn
-%%
-%% Detail = integer()
-%% Format = string()
-%% Args = [term(),...]
-%% IoLibReturn = term()
-%%
-%% Logs the Format string and Args, similar to io:format/1/2 etc. If
-%% Detail is not specified, the default detail level (which is 50) is used.
-%% Which log files the string will be logged in depends on the thresholds
-%% set with set_levels/3. Typically with default detail level, only the
-%% minor log file is used.
-
-format(Format) ->
- format(minor, Format, []).
-
-format(major, Format) ->
- format(major, Format, []);
-format(minor, Format) ->
- format(minor, Format, []);
-format(Detail, Format) when is_integer(Detail) ->
- format(Detail, Format, []);
-format(Format, Args) ->
- format(minor, Format, Args).
-
-format(Detail, Format, Args) ->
- Str =
- case catch io_lib:format(Format, Args) of
- {'EXIT',_} ->
- io_lib:format("illegal format; ~p with args ~p.\n",
- [Format,Args]);
- Valid -> Valid
- end,
- print_or_buffer(Detail, Str, self()).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml
-%%
-xhtml(HTML, XHTML) ->
- case get(basic_html) of
- true -> HTML;
- _ -> XHTML
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% odd_or_even() -> "odd" | "even"
-%%
-odd_or_even() ->
- case get(odd_or_even) of
- even ->
- put(odd_or_even, odd),
- "even";
- _ ->
- put(odd_or_even, even),
- "odd"
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timestamp_filename_get(Leader) -> string()
-%% Leader = string()
-%%
-%% Returns a string consisting of Leader concatenated with the current
-%% date and time. The resulting string is suitable as a filename.
-timestamp_filename_get(Leader) ->
- timestamp_get_internal(Leader,
- "~ts~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timestamp_get(Leader) -> string()
-%% Leader = string()
-%%
-%% Returns a string consisting of Leader concatenated with the current
-%% date and time. The resulting string is suitable for display.
-timestamp_get(Leader) ->
- timestamp_get_internal(Leader,
- "~ts~w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w").
-
-timestamp_get_internal(Leader, Format) ->
- {YY,MM,DD,H,M,S} = time_get(),
- io_lib:format(Format, [Leader,YY,MM,DD,H,M,S]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% time_get() -> {YY,MM,DD,H,M,S}
-%% YY = integer()
-%% MM = integer()
-%% DD = integer()
-%% H = integer()
-%% M = integer()
-%% S = integer()
-%%
-%% Returns the current Year,Month,Day,Hours,Minutes,Seconds.
-%% The function checks that the date doesn't wrap while calling
-%% getting the time.
-time_get() ->
- {YY,MM,DD} = date(),
- {H,M,S} = time(),
- case date() of
- {YY,MM,DD} ->
- {YY,MM,DD,H,M,S};
- _NewDay ->
- %% date changed between call to date() and time(), try again
- time_get()
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% make_config(Config) -> NewConfig
-%% Config = [{Key,Value},...]
-%% NewConfig = [{Key,Value},...]
-%%
-%% Creates a configuration list (currently returns it's input)
-
-make_config(Initial) ->
- Initial.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% update_config(Config, Update) -> NewConfig
-%% Config = [{Key,Value},...]
-%% Update = [{Key,Value},...] | {Key,Value}
-%% NewConfig = [{Key,Value},...]
-%%
-%% Adds or replaces the key-value pairs in config with those in update.
-%% Returns the updated list.
-
-update_config(Config, {Key,Val}) ->
- case lists:keymember(Key, 1, Config) of
- true ->
- lists:keyreplace(Key, 1, Config, {Key,Val});
- false ->
- [{Key,Val}|Config]
- end;
-update_config(Config, [Assoc|Assocs]) ->
- NewConfig = update_config(Config, Assoc),
- update_config(NewConfig, Assocs);
-update_config(Config, []) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% collect_cases(CurMod, TopCase, SkipList) ->
-%% BasicCaseList | {error,Reason}
-%%
-%% CurMod = atom()
-%% TopCase = term()
-%% SkipList = [term(),...]
-%% BasicCaseList = [term(),...]
-%%
-%% Parses the given test goal(s) in TopCase, and transforms them to a
-%% simple list of test cases to call, when executing the test suite.
-%%
-%% CurMod is the "current" module, that is, the module the last instruction
-%% was read from. May be be set to 'none' initially.
-%%
-%% SkipList is the list of test cases to skip and requirements to deny.
-%%
-%% The BasicCaseList is built out of TopCase, which may be any of the
-%% following terms:
-%%
-%% [] Nothing is added
-%% List list() The list is decomposed, and each element is
-%% treated according to this table
-%% Case atom() CurMod:Case(suite) is called
-%% {module,Case} CurMod:Case(suite) is called
-%% {Module,Case} Module:Case(suite) is called
-%% {module,Module,Case} Module:Case(suite) is called
-%% {module,Module,Case,Args} Module:Case is called with Args as arguments
-%% {dir,Dir} All modules *_SUITE in the named directory
-%% are listed, and each Module:all(suite) is called
-%% {dir,Dir,Pattern} All modules <Pattern>_SUITE in the named dir
-%% are listed, and each Module:all(suite) is called
-%% {conf,InitMF,Cases,FinMF}
-%% {conf,Props,InitMF,Cases,FinMF}
-%% InitMF is placed in the BasicCaseList, then
-%% Cases is treated according to this table, then
-%% FinMF is placed in the BasicCaseList. InitMF
-%% and FinMF are configuration manipulation
-%% functions. See below.
-%% {make,InitMFA,Cases,FinMFA}
-%% InitMFA is placed in the BasicCaseList, then
-%% Cases is treated according to this table, then
-%% FinMFA is placed in the BasicCaseList. InitMFA
-%% and FinMFA are make/unmake functions. If InitMFA
-%% fails, Cases are not run.
-%%
-%% When a function is called, above, it means that the function is invoked
-%% and the return is expected to be:
-%%
-%% [] Leaf case
-%% {req,ReqList} Kept for backwards compatibility - same as []
-%% {req,ReqList,Cases} Kept for backwards compatibility -
-%% Cases parsed recursively with collect_cases/3
-%% Cases (list) Recursively parsed with collect_cases/3
-%%
-%% Leaf cases are added to the BasicCaseList as Module:Case(Config). Each
-%% case is checked against the SkipList. If present, a skip instruction
-%% is inserted instead, which only prints the case name and the reason
-%% why the case was skipped in the log files.
-%%
-%% Configuration manipulation functions are called with the current
-%% configuration list as only argument, and are expected to return a new
-%% configuration list. Such a pair of function may, for example, start a
-%% server and stop it after a serie of test cases.
-%%
-%% SkipCases is expected to be in the format:
-%%
-%% Other Recursively parsed with collect_cases/3
-%% {Mod,Comment} Skip Mod, with Comment
-%% {Mod,Funcs,Comment} Skip listed functions in Mod with Comment
-%% {Mod,Func,Comment} Skip named function in Mod with Comment
-%%
--record(cc, {mod, % current module
- skip}). % skip list
-
-collect_all_cases(Top, Skip) when is_list(Skip) ->
- Result =
- case collect_cases(Top, #cc{mod=[],skip=Skip}, []) of
- {ok,Cases,_St} -> Cases;
- Other -> Other
- end,
- Result.
-
-
-collect_cases([], St, _) -> {ok,[],St};
-collect_cases([Case|Cs0], St0, Mode) ->
- case collect_cases(Case, St0, Mode) of
- {ok,FlatCases1,St1} ->
- case collect_cases(Cs0, St1, Mode) of
- {ok,FlatCases2,St} ->
- {ok,FlatCases1 ++ FlatCases2,St};
- {error,_Reason} = Error -> Error
- end;
- {error,_Reason} = Error -> Error
- end;
-
-
-collect_cases({module,Case}, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
- collect_case({St#cc.mod,Case}, St, Mode);
-collect_cases({module,Mod,Case}, St, Mode) ->
- collect_case({Mod,Case}, St, Mode);
-collect_cases({module,Mod,Case,Args}, St, Mode) ->
- collect_case({Mod,Case,Args}, St, Mode);
-
-collect_cases({dir,SubDir}, St, Mode) ->
- collect_files(SubDir, "*_SUITE", St, Mode);
-collect_cases({dir,SubDir,Pattern}, St, Mode) ->
- collect_files(SubDir, Pattern++"*", St, Mode);
-
-collect_cases({conf,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
- collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St, Mode);
-collect_cases({conf,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
- collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St, Mode);
-collect_cases({conf,InitMF,CaseList,FinMF}, St0, Mode) ->
- collect_cases({conf,[],InitMF,CaseList,FinMF}, St0, Mode);
-collect_cases({conf,Props,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) ->
- case init_props(Props) of
- {error,_} ->
- {ok,[],St};
- Props1 ->
- collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF},
- St, Mode)
- end;
-collect_cases({conf,Props,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) ->
- case init_props(Props) of
- {error,_} ->
- {ok,[],St};
- Props1 ->
- collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}},
- St, Mode)
- end;
-collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) ->
- case init_props(Props) of
- {error,_} ->
- {ok,[],St};
- Props1 ->
- Ref = make_ref(),
- Skips = St#cc.skip,
- Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)],
- Mode1 = [{Ref,Props2,undefined} | Mode],
- case in_skip_list({St#cc.mod,Conf}, Skips) of
- {true,Comment} -> % conf init skipped
- {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
- [] ++ [{conf,Ref,[],FinMF}]],St};
- {true,Name,Comment} when is_atom(Name) -> % all cases skipped
- case collect_cases(CaseList, St, Mode1) of
- {ok,[],_St} = Empty ->
- Empty;
- {ok,FlatCases,St1} ->
- Cases2Skip = FlatCases ++ [{conf,Ref,
- keep_name(Props1),
- FinMF}],
- Skipped = skip_cases_upto(Ref, Cases2Skip, Comment,
- conf, Mode1, skip_case),
- {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} |
- Skipped],St1};
- {error,_Reason} = Error ->
- Error
- end;
- {true,ToSkip,_} when is_list(ToSkip) -> % some cases skipped
- case collect_cases(CaseList,
- St#cc{skip=ToSkip++Skips}, Mode1) of
- {ok,[],_St} = Empty ->
- Empty;
- {ok,FlatCases,St1} ->
- {ok,[{conf,Ref,Props1,InitMF} |
- FlatCases ++ [{conf,Ref,
- keep_name(Props1),
- FinMF}]],St1#cc{skip=Skips}};
- {error,_Reason} = Error ->
- Error
- end;
- false ->
- case collect_cases(CaseList, St, Mode1) of
- {ok,[],_St} = Empty ->
- Empty;
- {ok,FlatCases,St1} ->
- {ok,[{conf,Ref,Props1,InitMF} |
- FlatCases ++ [{conf,Ref,
- keep_name(Props1),
- FinMF}]],St1};
- {error,_Reason} = Error ->
- Error
- end
- end
- end;
-
-collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) ->
- case collect_cases(CaseList, St0, Mode) of
- {ok,[],_St} = Empty -> Empty;
- {ok,FlatCases,St} ->
- Ref = make_ref(),
- {ok,[{make,Ref,InitMFA}|FlatCases ++
- [{make,Ref,FinMFA}]],St};
- {error,_Reason} = Error -> Error
- end;
-
-collect_cases({Module, Cases}, St, Mode) when is_list(Cases) ->
- case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of
- Result = {ok,_,_} ->
- Result;
- Other ->
- {error,Other}
- end;
-
-collect_cases({_Mod,_Case}=Spec, St, Mode) ->
- collect_case(Spec, St, Mode);
-
-collect_cases({_Mod,_Case,_Args}=Spec, St, Mode) ->
- collect_case(Spec, St, Mode);
-collect_cases(Case, St, Mode) when is_atom(Case), is_atom(St#cc.mod) ->
- collect_case({St#cc.mod,Case}, St, Mode);
-collect_cases(Other, St, _Mode) ->
- {error,{bad_subtest_spec,St#cc.mod,Other}}.
-
-collect_case({Mod,{conf,_,_,_,_}=Conf}, St, Mode) ->
- collect_case_invoke(Mod, Conf, [], St, Mode);
-
-collect_case(MFA, St, Mode) ->
- case in_skip_list(MFA, St#cc.skip) of
- {true,Comment} when Comment /= make_failed ->
- {ok,[{skip_case,{MFA,Comment},Mode}],St};
- _ ->
- case MFA of
- {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode);
- {_Mod,_Case,_Args} -> {ok,[MFA],St}
- end
- end.
-
-collect_case([], St, Acc, _Mode) ->
- {ok, Acc, St};
-
-collect_case([Case | Cases], St, Acc, Mode) ->
- {ok, FlatCases, NewSt} = collect_case({St#cc.mod, Case}, St, Mode),
- collect_case(Cases, NewSt, Acc ++ FlatCases, Mode).
-
-collect_case_invoke(Mod, Case, MFA, St, Mode) ->
- case get_fw_mod(undefined) of
- undefined ->
- case catch apply(Mod, Case, [suite]) of
- {'EXIT',_} ->
- {ok,[MFA],St};
- Suite ->
- collect_subcases(Mod, Case, MFA, St, Suite, Mode)
- end;
- _ ->
- Suite = test_server_sup:framework_call(get_suite,
- [Mod,Case],
- []),
- collect_subcases(Mod, Case, MFA, St, Suite, Mode)
- end.
-
-collect_subcases(Mod, Case, MFA, St, Suite, Mode) ->
- case Suite of
- [] when Case == all -> {ok,[],St};
- [] when element(1, Case) == conf -> {ok,[],St};
- [] -> {ok,[MFA],St};
-%%%! --- START Kept for backwards compatibility ---
-%%%! Requirements are not used
- {req,ReqList} ->
- collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode);
- {req,ReqList,SubCases} ->
- collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode);
-%%%! --- END Kept for backwards compatibility ---
- {Skip,Reason} when Skip==skip; Skip==skipped ->
- {ok,[{skip_case,{MFA,Reason},Mode}],St};
- {error,Reason} ->
- throw(Reason);
- SubCases ->
- collect_case_subcases(Mod, Case, SubCases, St, Mode)
- end.
-
-collect_case_subcases(Mod, Case, SubCases, St0, Mode) ->
- OldMod = St0#cc.mod,
- case collect_cases(SubCases, St0#cc{mod=Mod}, Mode) of
- {ok,FlatCases,St} ->
- {ok,FlatCases,St#cc{mod=OldMod}};
- {error,Reason} ->
- {error,{{Mod,Case},Reason}}
- end.
-
-collect_files(Dir, Pattern, St, Mode) ->
- {ok,Cwd} = file:get_cwd(),
- Dir1 = filename:join(Cwd, Dir),
- Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]),
- case catch filelib:wildcard(Wc) of
- {'EXIT', Reason} ->
- io:format("Could not collect files: ~p~n", [Reason]),
- {error,{collect_fail,Dir,Pattern}};
- Files ->
- %% convert to module names and remove duplicates
- Mods = lists:foldl(fun(File, Acc) ->
- Mod = fullname_to_mod(File),
- case lists:member(Mod, Acc) of
- true -> Acc;
- false -> [Mod | Acc]
- end
- end, [], Files),
- Tests = [{Mod,all} || Mod <- lists:sort(Mods)],
- collect_cases(Tests, St, Mode)
- end.
-
-fullname_to_mod(Path) when is_list(Path) ->
- %% If this is called with a binary, then we are probably in +fnu
- %% mode and have found a beam file with name encoded as latin1. We
- %% will let this crash since it can not work to load such a module
- %% anyway. It should be removed or renamed!
- list_to_atom(filename:rootname(filename:basename(Path))).
-
-collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode) ->
- case {check_deny(ReqList, St#cc.skip),SubCases} of
- {{denied,Comment},_SubCases} ->
- {ok,[{skip_case,{MFA,Comment},Mode}],St};
- {granted,[]} ->
- {ok,[MFA],St};
- {granted,SubCases} ->
- collect_case_subcases(Mod, Case, SubCases, St, Mode)
- end.
-
-check_deny([Req|Reqs], DenyList) ->
- case check_deny_req(Req, DenyList) of
- {denied,_Comment}=Denied -> Denied;
- granted -> check_deny(Reqs, DenyList)
- end;
-check_deny([], _DenyList) -> granted;
-check_deny(Req, DenyList) -> check_deny([Req], DenyList).
-
-check_deny_req({Req,Val}, DenyList) ->
- %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]),
- case lists:keysearch(Req, 1, DenyList) of
- {value,{_Req,DenyVal}} when Val >= DenyVal ->
- {denied,io_lib:format("Requirement ~p=~p", [Req,Val])};
- _ ->
- check_deny_req(Req, DenyList)
- end;
-check_deny_req(Req, DenyList) ->
- case lists:member(Req, DenyList) of
- true -> {denied,io_lib:format("Requirement ~p", [Req])};
- false -> granted
- end.
-
-in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) ->
- case in_skip_list(InitMF, SkipList) of
- {true,_} = Yes ->
- Yes;
- _ ->
- case proplists:get_value(name, Props) of
- undefined ->
- false;
- Name ->
- ToSkip =
- lists:flatmap(
- fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when
- M == Mod ->
- case proplists:get_value(name, SProps) of
- all ->
- [{M,all,Cmt}];
- Name ->
- case SCaseList of
- all ->
- [{M,all,Cmt}];
- _ ->
- [{M,F,Cmt} || F <- SCaseList]
- end;
- _ ->
- []
- end;
- (_) ->
- []
- end, SkipList),
- case ToSkip of
- [] ->
- false;
- _ ->
- case lists:keysearch(all, 2, ToSkip) of
- {value,{_,_,Cmt}} -> {true,Name,Cmt};
- _ -> {true,ToSkip,""}
- end
- end
- end
- end;
-
-in_skip_list({Mod,Func,_Args}, SkipList) ->
- in_skip_list({Mod,Func}, SkipList);
-in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) ->
- case lists:member(Func, Funcs) of
- true ->
- {true,Comment};
- _ ->
- in_skip_list({Mod,Func}, SkipList)
- end;
-in_skip_list({Mod,Func}, [{Mod,Func,Comment}|_SkipList]) ->
- {true,Comment};
-in_skip_list({Mod,_Func}, [{Mod,Comment}|_SkipList]) ->
- {true,Comment};
-in_skip_list({Mod,Func}, [_|SkipList]) ->
- in_skip_list({Mod,Func}, SkipList);
-in_skip_list(_, []) ->
- false.
-
-%% remove unnecessary properties
-init_props(Props) ->
- case get_repeat(Props) of
- Repeat = {_RepType,N} when N < 2 ->
- if N == 0 ->
- {error,{invalid_property,Repeat}};
- true ->
- lists:delete(Repeat, Props)
- end;
- _ ->
- Props
- end.
-
-keep_name(Props) ->
- lists:filter(fun({name,_}) -> true;
- ({suite,_}) -> true;
- (_) -> false end, Props).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Node handling functions %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_target_info() -> #target_info
-%%
-%% Returns a record containing system information for target
-
-get_target_info() ->
- controller_call(get_target_info).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_node(SlaveName, Type, Options) ->
-%% {ok, Slave} | {error, Reason}
-%%
-%% Called by test_server. See test_server:start_node/3 for details
-
-start_node(Name, Type, Options) ->
- T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(),
- format(minor, "Attempt to start ~w node ~p with options ~p",
- [Type, Name, Options]),
- case controller_call({start_node,Name,Type,Options}, T) of
- {{ok,Nodename}, Host, Cmd, Info, Warning} ->
- format(minor,
- "Successfully started node ~w on ~tp with command: ~ts",
- [Nodename, Host, Cmd]),
- format(major, "=node_start ~w", [Nodename]),
- case Info of
- [] -> ok;
- _ -> format(minor, Info)
- end,
- case Warning of
- [] -> ok;
- _ ->
- format(1, Warning),
- format(minor, Warning)
- end,
- {ok, Nodename};
- {fail,{Ret, Host, Cmd}} ->
- format(minor,
- "Failed to start node ~tp on ~tp with command: ~ts~n"
- "Reason: ~p",
- [Name, Host, Cmd, Ret]),
- {fail,Ret};
- {Ret, undefined, undefined} ->
- format(minor, "Failed to start node ~tp: ~p", [Name,Ret]),
- Ret;
- {Ret, Host, Cmd} ->
- format(minor,
- "Failed to start node ~tp on ~tp with command: ~ts~n"
- "Reason: ~p",
- [Name, Host, Cmd, Ret]),
- Ret
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% wait_for_node(Node) -> ok | {error,timeout}
-%%
-%% Wait for a slave/peer node which has been started with
-%% the option {wait,false}. This function returns when
-%% when the new node has contacted test_server_ctrl again
-
-wait_for_node(Slave) ->
- T = 10000 * test_server:timetrap_scale_factor(),
- case catch controller_call({wait_for_node,Slave},T) of
- {'EXIT',{timeout,_}} -> {error,timeout};
- ok -> ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% is_release_available(Release) -> true | false
-%% Release -> string()
-%%
-%% Test if a release (such as "r10b") is available to be
-%% started using start_node/3.
-
-is_release_available(Release) ->
- controller_call({is_release_available,Release}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% stop_node(Name) -> ok | {error,Reason}
-%%
-%% Clean up - test_server will stop this node
-
-stop_node(Slave) ->
- controller_call({stop_node,Slave}).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% DEBUGGER INTERFACE %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-i() ->
- hformat("Pid", "Initial Call", "Current Function", "Reducts", "Msgs"),
- Line=lists:duplicate(27, "-"),
- hformat(Line, Line, Line, Line, Line),
- display_info(processes(), 0, 0).
-
-p(A,B,C) ->
- pinfo(ts_pid(A,B,C)).
-p(X) when is_atom(X) ->
- pinfo(whereis(X));
-p({A,B,C}) ->
- pinfo(ts_pid(A,B,C));
-p(X) ->
- pinfo(X).
-
-t() ->
- t(wall_clock).
-t(X) ->
- element(1, statistics(X)).
-
-pi(Item,X) ->
- lists:keysearch(Item,1,p(X)).
-pi(Item,A,B,C) ->
- lists:keysearch(Item,1,p(A,B,C)).
-
-%% c:pid/3
-ts_pid(X,Y,Z) when is_integer(X), is_integer(Y), is_integer(Z) ->
- list_to_pid("<" ++ integer_to_list(X) ++ "." ++
- integer_to_list(Y) ++ "." ++
- integer_to_list(Z) ++ ">").
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% display_info(Pids, Reductions, Messages) -> void
-%% Pids = [pid(),...]
-%% Reductions = integer()
-%% Messaged = integer()
-%%
-%% Displays info, similar to c:i() about the processes in the list Pids.
-%% Also counts the total number of reductions and msgs for the listed
-%% processes, if called with Reductions = Messages = 0.
-
-display_info([Pid|T], R, M) ->
- case pinfo(Pid) of
- undefined ->
- display_info(T, R, M);
- Info ->
- Call = fetch(initial_call, Info),
- Curr = case fetch(current_function, Info) of
- {Mod,F,Args} when is_list(Args) ->
- {Mod,F,length(Args)};
- Other ->
- Other
- end,
- Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
- pformat(io_lib:format("~w", [Pid]),
- io_lib:format("~w", [Call]),
- io_lib:format("~w", [Curr]), Reds, LM),
- display_info(T, R+Reds, M + LM)
- end;
-display_info([], R, M) ->
- Line=lists:duplicate(27, "-"),
- hformat(Line, Line, Line, Line, Line),
- pformat("Total", "", "", R, M).
-
-hformat(A1, A2, A3, A4, A5) ->
- io:format("~-10s ~-27s ~-27s ~8s ~4s~n", [A1,A2,A3,A4,A5]).
-
-pformat(A1, A2, A3, A4, A5) ->
- io:format("~-10s ~-27s ~-27s ~8w ~4w~n", [A1,A2,A3,A4,A5]).
-
-fetch(Key, Info) ->
- case lists:keysearch(Key, 1, Info) of
- {value, {_, Val}} ->
- Val;
- _ ->
- 0
- end.
-
-pinfo(P) ->
- Node = node(),
- case node(P) of
- Node ->
- process_info(P);
- _ ->
- rpc:call(node(P),erlang,process_info,[P])
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Support functions for COVER %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% A module is included in the cover analysis if
-%% - it belongs to the tested application and is not listed in the
-%% {exclude,List} part of the App.cover file
-%% - it does not belong to the application, but is listed in the
-%% {include,List} part of the App.cover file
-%% - it does not belong to the application, but is listed in the
-%% {cross,[{Tag,List}]} part of the App.cover file
-%%
-%% The modules listed in the 'cross' part of the cover file are
-%% modules that are heavily used by other tests than the one where
-%% they are explicitly tested. They should then be listed as 'cross'
-%% in the cover file for the test where they are used but do not
-%% belong.
-%%
-%% After all tests are completed, the these modules can be analysed
-%% with coverage data from all tests where they are compiled - see
-%% cross_cover_analyse/2. The result is stored in a file called
-%% cross_cover.html in the run.<timestamp> directory of the
-%% test the modules belong to.
-%%
-%% Example:
-%% If the module m1 belongs to system s1 but is heavily used also in
-%% the tests for another system s2, then the cover files for the two
-%% systems could be like this:
-%%
-%% s1.cover:
-%% {include,[m1]}.
-%%
-%% s2.cover:
-%% {include,[....]}. % modules belonging to system s2
-%% {cross,[{s1,[m1]}]}.
-%%
-%% When the tests for both s1 and s2 are completed, run
-%% cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]), and
-%% the accumulated cover data for m1 will be written to
-%% S1LogDir/[run.<timestamp>/]cross_cover.html
-%%
-%% S1LogDir and S2LogDir are either the run.<timestamp> directories
-%% for the two tests, or the parent directory of these, in which case
-%% the latest run.<timestamp> directory will be chosen.
-%%
-%% Note that the m1 module will also be presented in the normal
-%% coverage log for s1 (due to the include statement in s1.cover), but
-%% that only includes the coverage achieved by the s1 test itself.
-%%
-%% The Tag in the 'cross' statement in the cover file has no other
-%% purpose than mapping the list of modules ([m1] in the example
-%% above) to the correct log directory where it should be included in
-%% the cross_cover.html file (S1LogDir in the example above).
-%% I.e. the value of the Tag has no meaning, it could be foo as well
-%% as s1 above, as long as the same Tag is used in the cover file and
-%% in the call to cross_cover_analyse/2.
-
-
-%% Cover compilation
-%% The compilation is executed on the target node
-start_cover(#cover{}=CoverInfo) ->
- cover_compile(CoverInfo);
-start_cover({log,CoverLogDir}=CoverInfo) ->
- %% Cover is controlled by the framework - here's the log
- put(test_server_cover_log_dir,CoverLogDir),
- {ok,CoverInfo}.
-
-cover_compile(CoverInfo) ->
- test_server:cover_compile(CoverInfo).
-
-%% Read the coverfile for an application and return a list of modules
-%% that are members of the application but shall not be compiled
-%% (Exclude), and a list of modules that are not members of the
-%% application but shall be compiled (Include).
-read_cover_file(none) ->
- {[],[],[]};
-read_cover_file(CoverFile) ->
- case file:consult(CoverFile) of
- {ok,List} ->
- case check_cover_file(List, [], [], []) of
- {ok,Exclude,Include,Cross} -> {Exclude,Include,Cross};
- error ->
- io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]),
- {[],[],[]}
- end;
- {error,Reason} ->
- io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n",
- [CoverFile,Reason]),
- {[],[],[]}
- end.
-
-check_cover_file([{exclude,all}|Rest], _, Include, Cross) ->
- check_cover_file(Rest, all, Include, Cross);
-check_cover_file([{exclude,Exclude}|Rest], _, Include, Cross) ->
- case lists:all(fun(M) -> is_atom(M) end, Exclude) of
- true ->
- check_cover_file(Rest, Exclude, Include, Cross);
- false ->
- error
- end;
-check_cover_file([{include,Include}|Rest], Exclude, _, Cross) ->
- case lists:all(fun(M) -> is_atom(M) end, Include) of
- true ->
- check_cover_file(Rest, Exclude, Include, Cross);
- false ->
- error
- end;
-check_cover_file([{cross,Cross}|Rest], Exclude, Include, _) ->
- case check_cross(Cross) of
- true ->
- check_cover_file(Rest, Exclude, Include, Cross);
- false ->
- error
- end;
-check_cover_file([], Exclude, Include, Cross) ->
- {ok,Exclude,Include,Cross}.
-
-check_cross([{Tag,Modules}|Rest]) ->
- case lists:all(fun(M) -> is_atom(M) end, [Tag|Modules]) of
- true ->
- check_cross(Rest);
- false ->
- false
- end;
-check_cross([]) ->
- true.
-
-
-%% Cover analysis, per application
-%% This analysis is executed on the target node once the test is
-%% completed for an application. This is not the same as the cross
-%% cover analysis, which can be executed on any node after the tests
-%% are finshed.
-%%
-%% This per application analysis writes the file cover.html in the
-%% application's run.<timestamp> directory.
-stop_cover(#cover{}=CoverInfo, TestDir) ->
- cover_analyse(CoverInfo, TestDir);
-stop_cover(_CoverInfo, _TestDir) ->
- %% Cover is probably controlled by the framework
- ok.
-
-make_relative(AbsDir, VsDir) ->
- DirTokens = filename:split(AbsDir),
- VsTokens = filename:split(VsDir),
- filename:join(make_relative1(DirTokens, VsTokens)).
-
-make_relative1([T | DirTs], [T | VsTs]) ->
- make_relative1(DirTs, VsTs);
-make_relative1(Last = [_File], []) ->
- Last;
-make_relative1(Last = [_File], VsTs) ->
- Ups = ["../" || _ <- VsTs],
- Ups ++ Last;
-make_relative1(DirTs, []) ->
- DirTs;
-make_relative1(DirTs, VsTs) ->
- Ups = ["../" || _ <- VsTs],
- Ups ++ DirTs.
-
-
-cover_analyse(CoverInfo, TestDir) ->
- write_default_cross_coverlog(TestDir),
-
- {ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)),
- write_coverlog_header(CoverLog),
- #cover{app=App,
- file=CoverFile,
- excl=Excluded,
- cross=Cross} = CoverInfo,
- io:fwrite(CoverLog, "<h1>Coverage for application '~w'</h1>\n", [App]),
- io:fwrite(CoverLog,
- "<p><a href=\"~ts\">Coverdata collected over all tests</a></p>",
- [?cross_coverlog_name]),
-
- io:fwrite(CoverLog, "<p>CoverFile: <code>~tp</code>\n", [CoverFile]),
- write_cross_cover_info(TestDir,Cross),
-
- case length(cover:imported_modules()) of
- Imps when Imps > 0 ->
- io:fwrite(CoverLog,
- "<p>Analysis includes data from ~w imported module(s).\n",
- [Imps]);
- _ ->
- ok
- end,
-
- io:fwrite(CoverLog, "<p>Excluded module(s): <code>~tp</code>\n", [Excluded]),
-
- Coverage = test_server:cover_analyse(TestDir, CoverInfo),
- write_binary_file(filename:join(TestDir,?raw_coverlog_name),
- term_to_binary(Coverage)),
-
- case lists:filter(fun({_M,{_,_,_}}) -> false;
- (_) -> true
- end, Coverage) of
- [] ->
- ok;
- Bad ->
- io:fwrite(CoverLog, "<p>Analysis failed for ~w module(s): "
- "<code>~w</code>\n",
- [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]])
- end,
-
- TotPercent = write_cover_result_table(CoverLog, Coverage),
- write_binary_file(filename:join(TestDir, ?cover_total),
- term_to_binary(TotPercent)).
-
-%% Cover analysis - accumulated over multiple tests
-%% This can be executed on any node after all tests are finished.
-%% Analyse = overview | details
-%% TagDirs = [{Tag,Dir}]
-%% Tag = atom(), identifier
-%% Dir = string(), the log directory for Tag, it can be a
-%% run.<timestamp> directory or the parent directory of
-%% such (in which case the latest run.<timestamp> directory
-%% is used)
-cross_cover_analyse(Analyse, TagDirs0) ->
- TagDirs = get_latest_run_dirs(TagDirs0),
- TagMods = get_all_cross_info(TagDirs,[]),
- TagDirMods = add_cross_modules(TagMods,TagDirs),
- CoverdataFiles = get_coverdata_files(TagDirMods),
- lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles),
- io:fwrite("Cover analysing...\n", []),
- DetailsFun =
- case Analyse of
- details ->
- fun(Dir,M) ->
- OutFile = filename:join(Dir,
- atom_to_list(M) ++
- ".CROSS_COVER.html"),
- case cover:analyse_to_file(M, OutFile, [html]) of
- {ok,_} ->
- {file,OutFile};
- Error ->
- Error
- end
- end;
- _ ->
- fun(_,_) -> undefined end
- end,
- Coverage = analyse_tests(TagDirMods, DetailsFun, []),
- cover:stop(),
- write_cross_cover_logs(Coverage,TagDirMods).
-
-write_cross_cover_info(_Dir,[]) ->
- ok;
-write_cross_cover_info(Dir,Cross) ->
- write_binary_file(filename:join(Dir,?cross_cover_info),
- term_to_binary(Cross)).
-
-%% For each test from which there are cross cover analysed
-%% modules, write a cross cover log (cross_cover.html).
-write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) ->
- case lists:keyfind(Tag,1,TagDirMods) of
- {_,Dir,Mods} when Mods=/=[] ->
- write_binary_file(filename:join(Dir,?raw_cross_coverlog_name),
- term_to_binary(Coverage)),
- CoverLogName = filename:join(Dir,?cross_coverlog_name),
- {ok,CoverLog} = open_html_file(CoverLogName),
- write_coverlog_header(CoverLog),
- io:fwrite(CoverLog,
- "<h1>Coverage results for \'~w\' from all tests</h1>\n",
- [Tag]),
- write_cover_result_table(CoverLog, Coverage),
- io:fwrite("Written file ~tp\n", [CoverLogName]);
- _ ->
- ok
- end,
- write_cross_cover_logs(T,TagDirMods);
-write_cross_cover_logs([],_) ->
- io:fwrite("done\n", []).
-
-%% Get the latest run.<timestamp> directories
-get_latest_run_dirs([{Tag,Dir}|Rest]) ->
- [{Tag,get_latest_run_dir(Dir)} | get_latest_run_dirs(Rest)];
-get_latest_run_dirs([]) ->
- [].
-
-get_latest_run_dir(Dir) ->
- case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of
- [] ->
- Dir;
- [H|T] ->
- get_latest_dir(T,H)
- end.
-
-get_latest_dir([H|T],Latest) when H>Latest ->
- get_latest_dir(T,H);
-get_latest_dir([_|T],Latest) ->
- get_latest_dir(T,Latest);
-get_latest_dir([],Latest) ->
- Latest.
-
-get_all_cross_info([{_Tag,Dir}|Rest],Acc) ->
- case file:read_file(filename:join(Dir,?cross_cover_info)) of
- {ok,Bin} ->
- TagMods = binary_to_term(Bin),
- get_all_cross_info(Rest,TagMods++Acc);
- _ ->
- get_all_cross_info(Rest,Acc)
- end;
-get_all_cross_info([],Acc) ->
- Acc.
-
-%% Associate the cross cover modules with their log directories
-add_cross_modules(TagMods,TagDirs)->
- do_add_cross_modules(TagMods,[{Tag,Dir,[]} || {Tag,Dir} <- TagDirs]).
-do_add_cross_modules([{Tag,Mods1}|TagMods],TagDirMods)->
- NewTagDirMods =
- case lists:keytake(Tag,1,TagDirMods) of
- {value,{Tag,Dir,Mods},Rest} ->
- [{Tag,Dir,lists:umerge(lists:sort(Mods1),Mods)}|Rest];
- false ->
- TagDirMods
- end,
- do_add_cross_modules(TagMods,NewTagDirMods);
-do_add_cross_modules([],TagDirMods) ->
- %% Just to get the modules in the same order as in the normal cover log
- [{Tag,Dir,lists:reverse(Mods)} || {Tag,Dir,Mods} <- TagDirMods].
-
-%% Find all exported coverdata files.
-get_coverdata_files(TagDirMods) ->
- lists:flatmap(
- fun({_,LatestDir,_}) ->
- filelib:wildcard(filename:join(LatestDir,"all.coverdata"))
- end,
- TagDirMods).
-
-
-%% For each test, analyse all modules
-%% Used for cross cover analysis.
-analyse_tests([{Tag,LastTest,Modules}|T], DetailsFun, Acc) ->
- Cov = analyse_modules(LastTest, Modules, DetailsFun, []),
- analyse_tests(T, DetailsFun, [{Tag,Cov}|Acc]);
-analyse_tests([], _DetailsFun, Acc) ->
- Acc.
-
-%% Analyse each module
-%% Used for cross cover analysis.
-analyse_modules(Dir, [M|Modules], DetailsFun, Acc) ->
- {ok,{M,{Cov,NotCov}}} = cover:analyse(M, module),
- Acc1 = [{M,{Cov,NotCov,DetailsFun(Dir,M)}}|Acc],
- analyse_modules(Dir, Modules, DetailsFun, Acc1);
-analyse_modules(_Dir, [], _DetailsFun, Acc) ->
- Acc.
-
-
-%% Support functions for writing the cover logs (both cross and normal)
-write_coverlog_header(CoverLog) ->
- case catch io:put_chars(CoverLog,html_header("Coverage results")) of
- {'EXIT',Reason} ->
- io:format("\n\nERROR: Could not write normal heading in coverlog.\n"
- "CoverLog: ~w\n"
- "Reason: ~p\n",
- [CoverLog,Reason]),
- io:format(CoverLog,"<html><body>\n", []);
- _ ->
- ok
- end.
-
-
-format_analyse(M,Cov,NotCov,undefined) ->
- io_lib:fwrite("<tr><td>~w</td>"
- "<td align=right>~w %</td>"
- "<td align=right>~w</td>"
- "<td align=right>~w</td></tr>\n",
- [M,pc(Cov,NotCov),Cov,NotCov]);
-format_analyse(M,Cov,NotCov,{file,File}) ->
- io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
- "<td align=right>~w %</td>"
- "<td align=right>~w</td>"
- "<td align=right>~w</td></tr>\n",
- [uri_encode(filename:basename(File)),
- M,pc(Cov,NotCov),Cov,NotCov]);
-format_analyse(M,Cov,NotCov,{lines,Lines}) ->
- CoverOutName = atom_to_list(M)++".COVER.html",
- {ok,CoverOut} = open_html_file(CoverOutName),
- write_not_covered(CoverOut,M,Lines),
- ok = file:close(CoverOut),
- io_lib:fwrite("<tr><td><a href=\"~ts\">~w</a></td>"
- "<td align=right>~w %</td>"
- "<td align=right>~w</td>"
- "<td align=right>~w</td></tr>\n",
- [uri_encode(CoverOutName),M,pc(Cov,NotCov),Cov,NotCov]);
-format_analyse(M,Cov,NotCov,{error,_}) ->
- io_lib:fwrite("<tr><td>~w</td>"
- "<td align=right>~w %</td>"
- "<td align=right>~w</td>"
- "<td align=right>~w</td></tr>\n",
- [M,pc(Cov,NotCov),Cov,NotCov]).
-
-
-pc(0,0) ->
- 0;
-pc(Cov,NotCov) ->
- round(Cov/(Cov+NotCov)*100).
-
-
-write_not_covered(CoverOut,M,Lines) ->
- io:put_chars(CoverOut,html_header("Coverage results for "++atom_to_list(M))),
- io:fwrite(CoverOut,
- "The following lines in module ~w are not covered:\n"
- "<table border=3 cellpadding=5>\n"
- "<th>Line Number</th>\n",
- [M]),
- lists:foreach(fun({{_M,Line},{0,1}}) ->
- io:fwrite(CoverOut,"<tr><td>~w</td></tr>\n", [Line]);
- (_) ->
- ok
- end,
- Lines),
- io:put_chars(CoverOut,"</table>\n</body>\n</html>\n").
-
-
-write_default_coverlog(TestDir) ->
- {ok,CoverLog} = open_html_file(filename:join(TestDir,?coverlog_name)),
- write_coverlog_header(CoverLog),
- io:put_chars(CoverLog,"Cover tool is not used\n</body></html>\n"),
- ok = file:close(CoverLog).
-
-write_default_cross_coverlog(TestDir) ->
- {ok,CrossCoverLog} =
- open_html_file(filename:join(TestDir,?cross_coverlog_name)),
- write_coverlog_header(CrossCoverLog),
- io:put_chars(CrossCoverLog,
- ["No cross cover modules exist for this application,",
- xhtml("<br>","<br />"),
- "or cross cover analysis is not completed.\n"
- "</body></html>\n"]),
- ok = file:close(CrossCoverLog).
-
-write_cover_result_table(CoverLog,Coverage) ->
- io:fwrite(CoverLog,
- "<p><table border=3 cellpadding=5>\n"
- "<tr><th>Module</th><th>Covered (%)</th><th>Covered (Lines)</th>"
- "<th>Not covered (Lines)</th>\n",
- []),
- {TotCov,TotNotCov} =
- lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) ->
- Str = format_analyse(M,Cov,NotCov,Details),
- io:fwrite(CoverLog,"~ts", [Str]),
- {AccCov+Cov,AccNotCov+NotCov};
- ({_M,{error,_Reason}},{AccCov,AccNotCov}) ->
- {AccCov,AccNotCov}
- end,
- {0,0},
- Coverage),
- TotPercent = pc(TotCov,TotNotCov),
- io:fwrite(CoverLog,
- "<tr><th align=left>Total</th><th align=right>~w %</th>"
- "<th align=right>~w</th><th align=right>~w</th></tr>\n"
- "</table>\n"
- "</body>\n"
- "</html>\n",
- [TotPercent,TotCov,TotNotCov]),
- ok = file:close(CoverLog),
- TotPercent.
-
-
-%%%-----------------------------------------------------------------
-%%% Support functions for writing files
-
-%% HTML files are always written with utf8 encoding
-html_header(Title) ->
- ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n"
- "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n"
- "<html>\n"
- "<head>\n"
- "<title>", Title, "</title>\n"
- "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n"
- "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">\n"
- "</head>\n"
- "<body bgcolor=\"white\" text=\"black\" "
- "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"].
-
-open_html_file(File) ->
- open_utf8_file(File).
-
-open_html_file(File,Opts) ->
- open_utf8_file(File,Opts).
-
-write_html_file(File,Content) ->
- write_file(File,Content,utf8).
-
-%% The 'major' log file, which is a pure text file is also written
-%% with utf8 encoding
-open_utf8_file(File) ->
- case file:open(File,AllOpts=[write,{encoding,utf8}]) of
- {error,Reason} -> {error,{Reason,{File,AllOpts}}};
- Result -> Result
- end.
-
-open_utf8_file(File,Opts) ->
- case file:open(File,AllOpts=[{encoding,utf8}|Opts]) of
- {error,Reason} -> {error,{Reason,{File,AllOpts}}};
- Result -> Result
- end.
-
-%% Write a file with specified encoding
-write_file(File,Content,latin1) ->
- file:write_file(File,Content);
-write_file(File,Content,utf8) ->
- write_binary_file(File,unicode:characters_to_binary(Content)).
-
-%% Write a file with only binary data
-write_binary_file(File,Content) ->
- file:write_file(File,Content).
-
-%% Encoding of hyperlinks in HTML files
-uri_encode(File) ->
- Encoding = file:native_name_encoding(),
- uri_encode(File,Encoding).
-
-uri_encode(File,Encoding) ->
- Components = filename:split(File),
- filename:join([uri_encode_comp(C,Encoding) || C <- Components]).
-
-%% Encode the reference to a "filename of the given encoding" so it
-%% can be inserted in a utf8 encoded HTML file.
-%% This does almost the same as http_uri:encode/1, except
-%% 1. it does not convert @, : and / (in order to preserve nodename and c:/)
-%% 2. if the file name is in latin1, it also encodes all
-%% characters >127 - i.e. latin1 but not ASCII.
-uri_encode_comp([Char|Chars],Encoding) ->
- Reserved = sets:is_element(Char, reserved()),
- case (Char>127 andalso Encoding==latin1) orelse Reserved of
- true ->
- [ $% | http_util:integer_to_hexlist(Char)] ++
- uri_encode_comp(Chars,Encoding);
- false ->
- [Char | uri_encode_comp(Chars,Encoding)]
- end;
-uri_encode_comp([],_) ->
- [].
-
-%% Copied from http_uri.erl, but slightly modified
-%% (not converting @, : and /)
-reserved() ->
- sets:from_list([$;, $&, $=, $+, $,, $?,
- $#, $[, $], $<, $>, $\", ${, $}, $|,
- $\\, $', $^, $%, $ ]).
-
-encoding(File) ->
- case epp:read_encoding(File) of
- none ->
- epp:default_encoding();
- E ->
- E
- end.
diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl
deleted file mode 100644
index c5ec3ccbe6..0000000000
--- a/lib/test_server/src/test_server_gl.erl
+++ /dev/null
@@ -1,301 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% This module implements group leader processes for test cases.
-%% Each group leader process handles output to the minor log file for
-%% a test case, and calls test_server_io to handle output to the common
-%% log files. The group leader processes are created and destroyed
-%% through the test_server_io module/process.
-
--module(test_server_gl).
--export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1,
- get_tc_supervisor/1,print/4,set_props/2]).
-
--export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]).
-
--record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor
- tc :: mfa(), %Current test case MFA
- minor :: 'none'|pid(), %Minor fd
- minor_monitor, %Monitor ref for minor fd
- capture :: 'none'|pid(), %Capture output
- reject_io :: boolean(), %Reject I/O requests...
- permit_io, %... and exceptions
- auto_nl=true :: boolean(), %Automatically add NL
- levels %{Stdout,Major,Minor}
- }).
-
-%% start_link()
-%% Start a new group leader process. Only to be called by
-%% the test_server_io process.
-
-start_link() ->
- case gen_server:start_link(?MODULE, [], []) of
- {ok,Pid} ->
- {ok,Pid};
- Other ->
- Other
- end.
-
-
-%% stop(Pid)
-%% Stop a group leader process. Only to be called by
-%% the test_server_io process.
-
-stop(GL) ->
- gen_server:cast(GL, stop).
-
-
-%% set_minor_fd(GL, Fd, MFA)
-%% GL = Pid for the group leader process
-%% Fd = file descriptor for the minor log file
-%% MFA = {M,F,A} for the test case owning the minor log file
-%%
-%% Register the file descriptor for the minor log file. Subsequent
-%% IO directed to the minor log file will be written to this file.
-%% Also register the currently executing process at the testcase
-%% supervisor corresponding to this group leader process.
-
-set_minor_fd(GL, Fd, MFA) ->
- req(GL, {set_minor_fd,Fd,MFA,self()}).
-
-
-%% unset_minor_fd(GL, Fd, MFA)
-%% GL = Pid for the group leader process
-%%
-%% Unregister the file descriptor for minor log file (typically
-%% because the test case has ended the minor log file is about
-%% to be closed). Subsequent IO (for example, by a process spawned
-%% by the testcase process) will go to the unexpected_io log file.
-
-unset_minor_fd(GL) ->
- req(GL, unset_minor_fd).
-
-
-%% get_tc_supervisor(GL)
-%% GL = Pid for the group leader process
-%%
-%% Return the Pid for the process that supervises the test case
-%% that has this group leader.
-
-get_tc_supervisor(GL) ->
- req(GL, get_tc_supervisor).
-
-
-%% print(GL, Detail, Format, Args) -> ok
-%% GL = Pid for the group leader process
-%% Detail = integer() | minor | major | html | stdout
-%% Msg = iodata()
-%% Printer = internal | pid()
-%%
-%% Print a message to one of the log files. If Detail is an integer,
-%% it will be compared to the levels (set by set_props/2) to
-%% determine which log file(s) that are to receive the output. If
-%% Detail is an atom, the value of the atom will directly determine
-%% which log file to use. IO to the minor log file will be handled
-%% directly by this group leader process (printing to the file set by
-%% set_minor_fd/3), and all other IO will be handled by calling
-%% test_server_io:print/3.
-
-print(GL, Detail, Msg, Printer) ->
- req(GL, {print,Detail,Msg,Printer}).
-
-
-%% set_props(GL, [PropertyTuple])
-%% GL = Pid for the group leader process
-%% PropertyTuple = {levels,{Show,Major,Minor}} |
-%% {auto_nl,boolean()} |
-%% {reject_io_reqs,boolean()}
-%%
-%% Set properties for this group leader process.
-
-set_props(GL, PropList) ->
- req(GL, {set_props,PropList}).
-
-%%% Internal functions.
-
-init([]) ->
- {ok,#st{tc_supervisor=none,
- minor=none,
- minor_monitor=none,
- capture=none,
- reject_io=false,
- permit_io=gb_sets:empty(),
- auto_nl=true,
- levels={1,19,10}
- }}.
-
-req(GL, Req) ->
- gen_server:call(GL, Req, infinity).
-
-handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) ->
- {reply,Pid,St};
-handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) ->
- Ref = erlang:monitor(process, Fd),
- {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref,
- tc_supervisor=Supervisor}};
-handle_call(unset_minor_fd, _From, St) ->
- {reply,ok,St#st{minor=none,tc_supervisor=none}};
-handle_call({set_props,PropList}, _From, St) ->
- {reply,ok,do_set_props(PropList, St)};
-handle_call({print,Detail,Msg,Printer}, {From,_}, St) ->
- output(Detail, Msg, Printer, From, St),
- {reply,ok,St}.
-
-handle_cast(stop, St) ->
- {stop,normal,St}.
-
-handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) ->
- case Reason of
- normal -> ok;
- _ ->
- Data = io_lib:format("=== WARNING === TC: ~w\n"
- "Got down from minor Fd ~w: ~w\n\n",
- [St#st.tc,St#st.minor,D]),
- test_server_io:print_unexpected(Data)
- end,
- {noreply,St#st{minor=none,minor_monitor=none}};
-handle_info({permit_io,Pid}, #st{permit_io=P}=St) ->
- {noreply,St#st{permit_io=gb_sets:add(Pid, P)}};
-handle_info({capture,Cap0}, St) ->
- Cap = case Cap0 of
- false -> none;
- Pid when is_pid(Cap0) -> Pid
- end,
- {noreply,St#st{capture=Cap}};
-handle_info({io_request,From,ReplyAs,Req}=IoReq, St) ->
- try io_req(Req, From, St) of
- passthrough ->
- group_leader() ! IoReq;
- Data ->
- case is_io_permitted(From, St) of
- false ->
- ok;
- true ->
- case St of
- #st{capture=none} ->
- ok;
- #st{capture=CapturePid} ->
- CapturePid ! {captured,Data}
- end,
- output(minor, Data, From, From, St)
- end,
- From ! {io_reply,ReplyAs,ok}
- catch
- _:_ ->
- From ! {io_reply,ReplyAs,{error,arguments}}
- end,
- {noreply,St};
-handle_info({structured_io,ClientPid,{Detail,Str}}, St) ->
- output(Detail, Str, ClientPid, ClientPid, St),
- {noreply,St};
-handle_info({printout,Detail,Format,Args}, St) ->
- Str = io_lib:format(Format, Args),
- output(Detail, Str, internal, none, St),
- {noreply,St};
-handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) ->
- %% The process overseeing the testcase process also used to be
- %% the group leader; thus, it is widely expected that it can be
- %% reached by sending a message to the group leader. Therefore
- %% we'll need to forward any non-recognized messaged to the test
- %% case supervisor.
- Pid ! Msg,
- {noreply,St};
-handle_info(_Msg, #st{}=St) ->
- %% There is no known supervisor process. Ignore this message.
- {noreply,St}.
-
-terminate(_, _) ->
- ok.
-
-do_set_props([{levels,Levels}|Ps], St) ->
- do_set_props(Ps, St#st{levels=Levels});
-do_set_props([{auto_nl,AutoNL}|Ps], St) ->
- do_set_props(Ps, St#st{auto_nl=AutoNL});
-do_set_props([{reject_io_reqs,Bool}|Ps], St) ->
- do_set_props(Ps, St#st{reject_io=Bool});
-do_set_props([], St) -> St.
-
-io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode ->
- unicode:characters_to_list(Bytes, Enc);
-io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) ->
- Str = Mod:Func(Format, Args),
- unicode:characters_to_list(Str, Encoding);
-io_req(_, _, _) -> passthrough.
-
-output(Level, Str, Sender, From, St) when is_integer(Level) ->
- case selected_by_level(Level, stdout, St) of
- true -> output(stdout, Str, Sender, From, St);
- false -> ok
- end,
- case selected_by_level(Level, major, St) of
- true -> output(major, Str, Sender, From, St);
- false -> ok
- end,
- case selected_by_level(Level, minor, St) of
- true -> output(minor, Str, Sender, From, St);
- false -> ok
- end;
-output(stdout, Str, _Sender, From, St) ->
- output_to_file(stdout, Str, From, St);
-output(html, Str, _Sender, From, St) ->
- output_to_file(html, Str, From, St);
-output(Level, Str, Sender, From, St) when is_atom(Level) ->
- output_to_file(Level, dress_output(Str, Sender, St), From, St).
-
-output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) ->
- Data = [io_lib:format("=== ~w:~w/~w\n", [M,F,A]),Data0],
- test_server_io:print(From, unexpected_io, Data),
- ok;
-output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) ->
- try
- io:put_chars(Fd, Data)
- catch
- Type:Reason ->
- Data1 =
- [io_lib:format("=== ERROR === TC: ~w\n"
- "Failed to write to minor Fd: ~w\n"
- "Type: ~w\n"
- "Reason: ~w\n",
- [TC,Fd,Type,Reason]),
- Data,"\n"],
- test_server_io:print(From, unexpected_io, Data1)
- end;
-output_to_file(Detail, Data, From, _) ->
- test_server_io:print(From, Detail, Data).
-
-is_io_permitted(From, #st{reject_io=true,permit_io=P}) ->
- gb_sets:is_member(From, P);
-is_io_permitted(_, #st{reject_io=false}) -> true.
-
-selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) ->
- Level =< Stdout;
-selected_by_level(Level, major, #st{levels={_,Major,_}}) ->
- Level =< Major;
-selected_by_level(Level, minor, #st{levels={_,_,Minor}}) ->
- Level >= Minor.
-
-dress_output([$=|_]=Str, internal, _) ->
- [Str,$\n];
-dress_output(Str, internal, _) ->
- ["=== ",Str,$\n];
-dress_output(Str, _, #st{auto_nl=AutoNL}) ->
- case AutoNL of
- true -> [Str,$\n];
- false -> Str
- end.
diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl
deleted file mode 100644
index 578f359010..0000000000
--- a/lib/test_server/src/test_server_internal.hrl
+++ /dev/null
@@ -1,61 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--define(priv_dir,"log_private").
--define(MAIN_PORT,3289).
--define(ACCEPT_TIMEOUT,20000).
-
-%% Target information generated by test_server:init_target_info/0
-%% Once initiated, this information will never change!!
--record(target_info, {os_family, % atom(); win32 | unix
- os_type, % result of os:type()
- host, % string(); the name of the target machine
- version, % string()
- system_version, % string()
- root_dir, % string()
- test_server_dir, % string()
- emulator, % string()
- otp_release, % string()
- username, % string()
- cookie, % string(); Cookie for target node
- naming, % string(); "-name" | "-sname"
- master}). % string(); Was used for OSE's master
- % node for main target and slave nodes.
- % For other platforms the target node
- % itself is master for slave nodes
-
-%% Temporary information generated by test_server_ctrl:read_parameters/X
-%% This information is used when starting the main target, and for
-%% initiating the #target_info record.
--record(par, {type,
- target,
- naming,
- master,
- cookie}).
-
-
--record(cover, {app, % application; Name | none
- file, % cover spec file
- incl, % explicitly include modules
- excl, % explicitly exclude modules
- level, % analyse level; details | overview
- mods, % actually cover compiled modules
- stop=true, % stop cover after analyse; boolean()
- cross}).% cross cover analyse info
diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl
deleted file mode 100644
index 0d881d0ada..0000000000
--- a/lib/test_server/src/test_server_io.erl
+++ /dev/null
@@ -1,452 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% This module implements a process with the registered name 'test_server_io',
-%% which has two main responsibilities:
-%%
-%% * Manage group leader processes (see the test_server_gl module)
-%% for test cases. A group_leader process is obtained by calling
-%% get_gl/1. Group leader processes will be kept alive as along as
-%% the 'test_server_io' process is alive.
-%%
-%% * Handle output to the common log files (stdout, major, html,
-%% unexpected_io).
-%%
-
--module(test_server_io).
--export([start_link/0,stop/1,get_gl/1,set_fd/2,
- start_transaction/0,end_transaction/0,
- print_buffered/1,print/3,print_unexpected/1,
- set_footer/1,set_job_name/1,set_gl_props/1,
- reset_state/0,finish/0]).
-
--export([init/1,handle_call/3,handle_info/2,terminate/2]).
-
--record(st, {fds, % Singleton fds (gb_tree)
- tags=[], % Known tag types
- shared_gl :: pid(), % Shared group leader
- gls, % Group leaders (gb_set)
- io_buffering=false, % I/O buffering
- buffered, % Buffered I/O requests
- html_footer, % HTML footer
- job_name, % Name of current job.
- gl_props, % Properties for GL
- phase, % Indicates current mode
- offline_buffer, % Buffer I/O during startup
- stopping, % Reply to when process stopped
- pending_ops % Perform when process idle
- }).
-
-start_link() ->
- case whereis(?MODULE) of
- undefined ->
- case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
- {ok,Pid} ->
- {ok,Pid};
- Other ->
- Other
- end;
- Pid ->
- %% already running, reset the state
- reset_state(),
- {ok,Pid}
- end.
-
-stop(FilesToClose) ->
- OldGL = group_leader(),
- group_leader(self(), self()),
- req({stop,FilesToClose}),
- group_leader(OldGL, self()),
- ok.
-
-finish() ->
- req(finish).
-
-%% get_gl(Shared) -> Pid
-%% Shared = boolean()
-%% Pid = pid()
-%%
-%% Return a group leader (a process using the test_server_gl module).
-%% If Shared is true, the shared group leader is returned (suitable for
-%% running sequential test cases), otherwise a new group leader process
-%% is spawned. Group leader processes will live until the
-%% 'test_server_io' process is stopped.
-
-get_gl(Shared) when is_boolean(Shared) ->
- req({get_gl,Shared}).
-
-%% set_fd(Tag, Fd) -> ok.
-%% Tag = major | html | unexpected_io
-%% Fd = a file descriptor (as returned by file:open/2)
-%%
-%% Associate a file descriptor with the given Tag. This
-%% Tag can later be used in when calling to print/3.
-
-set_fd(Tag, Fd) ->
- req({set_fd,Tag,Fd}).
-
-%% start_transaction()
-%%
-%% Subsequent calls to print/3 from the process executing start_transaction/0
-%% will cause the messages to be buffered instead of printed directly.
-
-start_transaction() ->
- req({start_transaction,self()}).
-
-%% end_transaction()
-%%
-%% End the transaction started by start_transaction/0. Subsequent calls to
-%% print/3 will cause the message to be printed directly.
-
-end_transaction() ->
- req({end_transaction,self()}).
-
-%% print(From, Tag, Msg)
-%% From = pid()
-%% Tag = stdout, or any tag that has been registered using set_fd/2
-%% Msg = string or iolist
-%%
-%% Either print Msg to the file identified by Tag, or buffer the message
-%% start_transaction/0 has been called from the process From.
-%%
-%% NOTE: The tags have various special meanings. For example, 'html'
-%% is assumed to be a HTML file.
-
-print(From, Tag, Msg) ->
- req({print,From,Tag,Msg}).
-
-%% print_buffered(Pid)
-%% Pid = pid()
-%%
-%% Print all messages buffered in the *first* transaction buffered for Pid.
-%% (If start_transaction/0 and end_transaction/0 has been called N times,
-%% print_buffered/1 must be called N times to print all transactions.)
-
-print_buffered(Pid) ->
- req({print_buffered,Pid}).
-
-%% print_unexpected(Msg)
-%% Msg = string or iolist
-%%
-%% Print the given string in the unexpected_io log.
-
-print_unexpected(Msg) ->
- print(xxxFrom,unexpected_io,Msg).
-
-%% set_footer(IoData)
-%%
-%% Set a footer for the file associated with the 'html' tag.
-%% It will be used by print/3 to print a footer for the HTML file.
-
-set_footer(Footer) ->
- req({set_footer,Footer}).
-
-%% set_job_name(Name)
-%%
-%% Set a name for the currently running job. The name will be used
-%% when printing to 'stdout'.
-%%
-
-set_job_name(Name) ->
- req({set_job_name,Name}).
-
-%% set_gl_props(PropList)
-%%
-%% Set properties for group leader processes. When a group_leader process
-%% is created, test_server_gl:set_props(PropList) will be called.
-
-set_gl_props(PropList) ->
- req({set_gl_props,PropList}).
-
-%% reset_state
-%%
-%% Reset the initial state
-reset_state() ->
- req(reset_state).
-
-%%% Internal functions.
-
-init([]) ->
- process_flag(trap_exit, true),
- Empty = gb_trees:empty(),
- {ok,Shared} = test_server_gl:start_link(),
- {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
- io_buffering=gb_sets:empty(),
- buffered=Empty,
- html_footer="</body>\n</html>\n",
- job_name="<name not set>",
- gl_props=[],
- phase=starting,
- offline_buffer=[],
- pending_ops=[]}}.
-
-req(Req) ->
- gen_server:call(?MODULE, Req, infinity).
-
-handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) ->
- {ok,Pid} = test_server_gl:start_link(),
- test_server_gl:set_props(Pid, Props),
- {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}};
-handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) ->
- {reply,Shared,St};
-handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0,tags=Tags0,
- offline_buffer=OfflineBuff}=St) ->
- Fds = gb_trees:enter(Tag, Fd, Fds0),
- St1 = St#st{fds=Fds,tags=[Tag|lists:delete(Tag, Tags0)]},
- OfflineBuff1 =
- if OfflineBuff == [] ->
- [];
- true ->
- %% Fd ready, print anything buffered for associated Tag
- lists:filtermap(fun({T,From,Str}) when T == Tag ->
- output(From, Tag, Str, St1),
- false;
- (_) ->
- true
- end, lists:reverse(OfflineBuff))
- end,
- {reply,ok,St1#st{phase=started,
- offline_buffer=lists:reverse(OfflineBuff1)}};
-handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0,
- buffered=Buf0}=St) ->
- Buf = case gb_trees:is_defined(Pid, Buf0) of
- false -> gb_trees:insert(Pid, queue:new(), Buf0);
- true -> Buf0
- end,
- Buffer = gb_sets:add(Pid, Buffer0),
- {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}};
-handle_call({print,From,Tag,Str}, _From, St0) ->
- St = output(From, Tag, Str, St0),
- {reply,ok,St};
-handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0,
- buffered=Buffered0}=St0) ->
- Q0 = gb_trees:get(Pid, Buffered0),
- Q = queue:in(eot, Q0),
- Buffered = gb_trees:update(Pid, Q, Buffered0),
- Buffer = gb_sets:delete_any(Pid, Buffer0),
- St = St0#st{io_buffering=Buffer,buffered=Buffered},
- {reply,ok,St};
-handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) ->
- Q0 = gb_trees:get(Pid, Buffered0),
- Q = do_print_buffered(Q0, St0),
- Buffered = gb_trees:update(Pid, Q, Buffered0),
- St = St0#st{buffered=Buffered},
- {reply,ok,St};
-handle_call({set_footer,Footer}, _From, St) ->
- {reply,ok,St#st{html_footer=Footer}};
-handle_call({set_job_name,Name}, _From, St) ->
- {reply,ok,St#st{job_name=Name}};
-handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) ->
- test_server_gl:set_props(Shared, Props),
- {reply,ok,St#st{gl_props=Props}};
-handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) ->
- %% can't reset during stopping phase, save op for later
- Op = fun(NewSt) ->
- {_,Result,NewSt1} = handle_call(reset_state, From, NewSt),
- {Result,NewSt1}
- end,
- {noreply,St#st{pending_ops=[{From,Op}|Ops]}};
-handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls,
- offline_buffer=OfflineBuff}) ->
- %% close open log files
- lists:foreach(fun(Tag) ->
- case gb_trees:lookup(Tag, Fds) of
- none ->
- ok;
- {value,Fd} ->
- file:close(Fd)
- end
- end, Tags),
- GlList = gb_sets:to_list(Gls),
- [test_server_gl:stop(GL) || GL <- GlList],
- timer:sleep(100),
- case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlList) of
- [] ->
- ok;
- _ ->
- timer:sleep(2000),
- [exit(GL, kill) || GL <- GlList]
- end,
- Empty = gb_trees:empty(),
- {ok,Shared} = test_server_gl:start_link(),
- {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
- io_buffering=gb_sets:empty(),
- buffered=Empty,
- html_footer="</body>\n</html>\n",
- job_name="<name not set>",
- gl_props=[],
- phase=starting,
- offline_buffer=OfflineBuff,
- pending_ops=[]}};
-handle_call({stop,FdTags}, From, #st{fds=Fds0,tags=Tags0,
- shared_gl=SGL,gls=Gls0}=St0) ->
- St = St0#st{gls=gb_sets:insert(SGL, Gls0),phase=stopping,stopping=From},
- gc(St),
- %% close open log files
- {Fds1,Tags1} = lists:foldl(fun(Tag, {Fds,Tags}) ->
- case gb_trees:lookup(Tag, Fds) of
- none ->
- {Fds,Tags};
- {value,Fd} ->
- file:close(Fd),
- {gb_trees:delete(Tag, Fds),
- lists:delete(Tag, Tags)}
- end
- end, {Fds0,Tags0}, FdTags),
- %% Give the users of the surviving group leaders some
- %% time to finish.
- erlang:send_after(1000, self(), stop_group_leaders),
- {noreply,St#st{fds=Fds1,tags=Tags1}};
-handle_call(finish, From, St) ->
- gen_server:reply(From, ok),
- {stop,normal,St}.
-
-handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
- Gls = gb_sets:delete_any(Pid, Gls0),
- case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
- true ->
- %% No more group leaders left.
- gen_server:reply(From, ok),
- {noreply,St#st{gls=Gls,phase=stopping,stopping=undefined}};
- false ->
- %% Wait for more group leaders to finish.
- {noreply,St#st{gls=Gls,phase=stopping}}
- end;
-handle_info({'EXIT',_Pid,Reason}, _St) ->
- exit(Reason);
-handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
- %% Stop the remaining group leaders.
- GlPids = gb_sets:to_list(Gls),
- [test_server_gl:stop(GL) || GL <- GlPids],
- timer:sleep(100),
- Wait =
- case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlPids) of
- [] -> 0;
- _ -> 2000
- end,
- erlang:send_after(Wait, self(), kill_group_leaders),
- {noreply,St};
-handle_info(kill_group_leaders, #st{gls=Gls,stopping=From,
- pending_ops=Ops}=St) ->
- [exit(GL, kill) || GL <- gb_sets:to_list(Gls)],
- if From /= undefined ->
- gen_server:reply(From, ok);
- true -> % reply has been sent already
- ok
- end,
- %% we're idle, check if any ops are pending
- St1 = lists:foldr(fun({ReplyTo,Op},NewSt) ->
- {Result,NewSt1} = Op(NewSt),
- gen_server:reply(ReplyTo, Result),
- NewSt1
- end, St#st{phase=idle,pending_ops=[]}, Ops),
- {noreply,St1};
-handle_info(Other, St) ->
- io:format("Ignoring: ~p\n", [Other]),
- {noreply,St}.
-
-terminate(_, _) ->
- ok.
-
-output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0,
- phase=Phase,offline_buffer=OfflineBuff}=St) ->
- case gb_sets:is_member(From, Buffered) of
- false ->
- case do_output(Tag, Str, Phase, St) of
- buffer when length(OfflineBuff)>500 ->
- %% something's wrong, clear buffer
- St#st{offline_buffer=[]};
- buffer ->
- St#st{offline_buffer=[{Tag,From,Str}|OfflineBuff]};
- _ ->
- St
- end;
- true ->
- Q0 = gb_trees:get(From, Buf0),
- Q = queue:in({Tag,Str}, Q0),
- Buf = gb_trees:update(From, Q, Buf0),
- St#st{buffered=Buf}
- end.
-
-do_output(stdout, Str, _, #st{job_name=undefined}) ->
- io:put_chars(Str);
-do_output(stdout, Str0, _, #st{job_name=Name}) ->
- Str = io_lib:format("Testing ~ts: ~ts\n", [Name,Str0]),
- io:put_chars(Str);
-do_output(Tag, Str, Phase, #st{fds=Fds}=St) ->
- case gb_trees:lookup(Tag, Fds) of
- none when Phase /= started ->
- buffer;
- none ->
- S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n",
- [?MODULE,?LINE,Tag]),
- do_output(stdout, [S,Str], Phase, St);
- {value,Fd} ->
- try
- io:put_chars(Fd, Str),
- case Tag of
- html -> finalise_table(Fd, St);
- _ -> ok
- end
- catch _:Error ->
- S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to "
- "log file '~p': ~p\n",
- [?MODULE,?LINE,Tag,Error]),
- do_output(stdout, [S,Str], Phase, St)
- end
- end.
-
-finalise_table(Fd, #st{html_footer=Footer}) ->
- case file:position(Fd, {cur,0}) of
- {ok,Pos} ->
- %% We are writing to a seekable file. Finalise so
- %% we get complete valid (and viewable) HTML code.
- %% Then rewind to overwrite the finalising code.
- io:put_chars(Fd, ["\n</table>\n",Footer]),
- file:position(Fd, Pos);
- {error,epipe} ->
- %% The file is not seekable. We cannot erase what
- %% we've already written --- so the reader will
- %% have to wait until we're done.
- ok
- end.
-
-do_print_buffered(Q0, St) ->
- Item = queue:get(Q0),
- Q = queue:drop(Q0),
- case Item of
- eot ->
- Q;
- {Tag,Str} ->
- do_output(Tag, Str, undefined, St),
- do_print_buffered(Q, St)
- end.
-
-gc(#st{gls=Gls0}) ->
- InUse0 = [begin
- case process_info(P, group_leader) of
- {group_leader,GL} -> GL;
- undefined -> undefined
- end
- end || P <- processes()],
- InUse = ordsets:from_list(InUse0),
- Gls = gb_sets:to_list(Gls0),
- NotUsed = ordsets:subtract(Gls, InUse),
- [test_server_gl:stop(Pid) || Pid <- NotUsed],
- ok.
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
deleted file mode 100644
index 4e6839fc6b..0000000000
--- a/lib/test_server/src/test_server_node.erl
+++ /dev/null
@@ -1,759 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(test_server_node).
--compile(r12).
-
-%%%
-%%% The same compiled code for this module must be possible to load
-%%% in R12B and later.
-%%%
-
-%% Test Controller interface
--export([is_release_available/1]).
--export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]).
--export([start_node/5, stop_node/1]).
--export([kill_nodes/0, nodedown/1]).
-%% Internal export
--export([node_started/1,trc/1,handle_debug/4]).
-
--include("test_server_internal.hrl").
--record(slave_info, {name,socket,client}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% %%%
-%%% All code in this module executes on the test_server_ctrl process %%%
-%%% except for node_started/1 and trc/1 which execute on a new node. %%%
-%%% %%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-is_release_available(Rel) when is_atom(Rel) ->
- is_release_available(atom_to_list(Rel));
-is_release_available(Rel) ->
- case os:type() of
- {unix,_} ->
- Erl = find_release(Rel),
- case Erl of
- none -> false;
- _ -> filelib:is_regular(Erl)
- end;
- _ ->
- false
- end.
-
-nodedown(Sock) ->
- Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'},
- case ets:match(slave_tab,Match) of
- [[Node,_Client]] -> % Slave node died
- gen_tcp:close(Sock),
- ets:delete(slave_tab,Node),
- slave_died;
- [] ->
- ok
- end.
-
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Start trace node
-%%%
-start_tracer_node(TraceFile,TI) ->
- Match = #slave_info{name='$1',_='_'},
- SlaveNodes = lists:map(fun([N]) -> [" ",N] end,
- ets:match(slave_tab,Match)),
- TargetNode = node(),
- Cookie = TI#target_info.cookie,
- {ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]),
- {ok,TracePort} = inet:port(LSock),
- Prog = quote_progname(pick_erl_program(default)),
- Cmd = lists:concat([Prog, " -sname tracer -hidden -setcookie ", Cookie,
- " -s ", ?MODULE, " trc ", TraceFile, " ",
- TracePort, " ", TI#target_info.os_family]),
- spawn(fun() -> print_data(open_port({spawn,Cmd},[stream])) end),
-%! open_port({spawn,Cmd},[stream]),
- case gen_tcp:accept(LSock,?ACCEPT_TIMEOUT) of
- {ok,Sock} ->
- gen_tcp:close(LSock),
- receive
- {tcp,Sock,Result} when is_binary(Result) ->
- case unpack(Result) of
- error ->
- gen_tcp:close(Sock),
- {error,timeout};
- {ok,started} ->
- trace_nodes(Sock,[TargetNode | SlaveNodes]),
- {ok,Sock};
- {ok,Error} -> Error
- end;
- {tcp_closed,Sock} ->
- gen_tcp:close(Sock),
- {error,could_not_start_tracernode}
- after ?ACCEPT_TIMEOUT ->
- gen_tcp:close(Sock),
- {error,timeout}
- end;
- Error ->
- gen_tcp:close(LSock),
- {error,{could_not_start_tracernode,Error}}
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Start a tracer on each of these nodes and set flags and patterns
-%%%
-trace_nodes(Sock,Nodes) ->
- Bin = term_to_binary({add_nodes,Nodes}),
- ok = gen_tcp:send(Sock, [1|Bin]),
- receive_ack(Sock).
-
-
-receive_ack(Sock) ->
- receive
- {tcp,Sock,Bin} when is_binary(Bin) ->
- case unpack(Bin) of
- error -> receive_ack(Sock);
- {ok,_} -> ok
- end;
- _ ->
- receive_ack(Sock)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Stop trace node
-%%%
-stop_tracer_node(Sock) ->
- Bin = term_to_binary(id(stop)),
- ok = gen_tcp:send(Sock, [1|Bin]),
- receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end,
- ok.
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% trc([TraceFile,Nodes]) -> ok
-%%
-%% Start tracing on the given nodes
-%%
-%% This function executes on the new node
-%%
-trc([TraceFile, PortAtom, Type]) ->
- {Result,Patterns} =
- case file:consult(TraceFile) of
- {ok,TI} ->
- Pat = parse_trace_info(lists:flatten(TI)),
- {started,Pat};
- Error ->
- {Error,[]}
- end,
- Port = list_to_integer(atom_to_list(PortAtom)),
- case catch gen_tcp:connect("localhost", Port, [binary,
- {reuseaddr,true},
- {packet,2}]) of
- {ok,Sock} ->
- BinResult = term_to_binary(Result),
- ok = gen_tcp:send(Sock,[1|BinResult]),
- trc_loop(Sock,Patterns,Type);
- _else ->
- ok
- end,
- erlang:halt().
-trc_loop(Sock,Patterns,Type) ->
- receive
- {tcp,Sock,Bin} ->
- case unpack(Bin) of
- error ->
- ttb:stop(),
- gen_tcp:close(Sock);
- {ok,{add_nodes,Nodes}} ->
- add_nodes(Nodes,Patterns,Type),
- Bin = term_to_binary(id(ok)),
- ok = gen_tcp:send(Sock, [1|Bin]),
- trc_loop(Sock,Patterns,Type);
- {ok,stop} ->
- ttb:stop(),
- gen_tcp:close(Sock)
- end;
- {tcp_closed,Sock} ->
- ttb:stop(),
- gen_tcp:close(Sock)
- end.
-add_nodes(Nodes,Patterns,_Type) ->
- ttb:tracer(Nodes,[{file,{local, test_server}},
- {handler, {{?MODULE,handle_debug},initial}}]),
- ttb:p(all,[call,timestamp]),
- lists:foreach(fun({TP,M,F,A,Pat}) -> ttb:TP(M,F,A,Pat);
- ({CTP,M,F,A}) -> ttb:CTP(M,F,A)
- end,
- Patterns).
-
-parse_trace_info([{TP,M,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
- [{TP,M,'_','_',Pat}|parse_trace_info(Pats)];
-parse_trace_info([{TP,M,F,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
- [{TP,M,F,'_',Pat}|parse_trace_info(Pats)];
-parse_trace_info([{TP,M,F,A,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
- [{TP,M,F,A,Pat}|parse_trace_info(Pats)];
-parse_trace_info([CTP|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
- [{CTP,'_','_','_'}|parse_trace_info(Pats)];
-parse_trace_info([{CTP,M}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
- [{CTP,M,'_','_'}|parse_trace_info(Pats)];
-parse_trace_info([{CTP,M,F}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
- [{CTP,M,F,'_'}|parse_trace_info(Pats)];
-parse_trace_info([{CTP,M,F,A}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
- [{CTP,M,F,A}|parse_trace_info(Pats)];
-parse_trace_info([]) ->
- [];
-parse_trace_info([_other|Pats]) -> % ignore
- parse_trace_info(Pats).
-
-handle_debug(Out,Trace,TI,initial) ->
- handle_debug(Out,Trace,TI,0);
-handle_debug(_Out,end_of_trace,_TI,N) ->
- N;
-handle_debug(Out,Trace,_TI,N) ->
- print_trc(Out,Trace,N),
- N+1.
-
-print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) ->
- io:format(Out,
- "~w: ~s~n"
- "Process : ~w~n"
- "Call : ~w:~w/~w~n"
- "Arguments : ~p~n"
- "Caller : ~w~n~n",
- [N,ts(Ts),P,M,F,length(A),A,C]);
-print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) ->
- io:format(Out,
- "~w: ~s~n"
- "Process : ~w~n"
- "Call : ~w:~w/~w~n"
- "Arguments : ~p~n~n",
- [N,ts(Ts),P,M,F,length(A),A]);
-print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) ->
- io:format(Out,
- "~w: ~s~n"
- "Process : ~w~n"
- "Return from : ~w:~w/~w~n"
- "Return value : ~p~n~n",
- [N,ts(Ts),P,M,F,A,R]);
-print_trc(Out,{drop,X},N) ->
- io:format(Out,
- "~w: Tracer dropped ~w messages - too busy~n~n",
- [N,X]);
-print_trc(Out,Trace,N) ->
- Ts = element(size(Trace),Trace),
- io:format(Out,
- "~w: ~s~n"
- "Trace : ~p~n~n",
- [N,ts(Ts),Trace]).
-ts({_, _, Micro} = Now) ->
- {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now),
- io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w,~6.6.0w",
- [Y,M,D,H,Min,S,Micro]).
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Start slave/peer nodes (initiated by test_server:start_node/5)
-%%%
-start_node(SlaveName, slave, Options, From, TI) when is_list(SlaveName) ->
- start_node_slave(list_to_atom(SlaveName), Options, From, TI);
-start_node(SlaveName, slave, Options, From, TI) ->
- start_node_slave(SlaveName, Options, From, TI);
-start_node(SlaveName, peer, Options, From, TI) when is_atom(SlaveName) ->
- start_node_peer(atom_to_list(SlaveName), Options, From, TI);
-start_node(SlaveName, peer, Options, From, TI) ->
- start_node_peer(SlaveName, Options, From, TI);
-start_node(_SlaveName, _Type, _Options, _From, _TI) ->
- not_implemented_yet.
-
-%%
-%% Peer nodes are always started on the same host as test_server_ctrl
-%%
-%% (Socket communication is used since in early days the test target
-%% and the test server controller node could be on different hosts and
-%% the target could not know the controller node via erlang
-%% distribution)
-%%
-start_node_peer(SlaveName, OptList, From, TI) ->
- SuppliedArgs = start_node_get_option_value(args, OptList, []),
- Cleanup = start_node_get_option_value(cleanup, OptList, true),
- HostStr = test_server_sup:hoststr(),
- {ok,LSock} = gen_tcp:listen(0,[binary,
- {reuseaddr,true},
- {packet,2}]),
- {ok,WaitPort} = inet:port(LSock),
- NodeStarted = lists:concat([" -s ", ?MODULE, " node_started ",
- HostStr, " ", WaitPort]),
-
- % Support for erl_crash_dump files..
- CrashFile = filename:join([TI#target_info.test_server_dir,
- "erl_crash_dump."++cast_to_list(SlaveName)]),
- CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]),
- FailOnError = start_node_get_option_value(fail_on_error, OptList, true),
- Pa = TI#target_info.test_server_dir,
- Prog0 = start_node_get_option_value(erl, OptList, default),
- Prog = quote_progname(pick_erl_program(Prog0)),
- Args =
- case string:str(SuppliedArgs,"-setcookie") of
- 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs;
- _ -> SuppliedArgs
- end,
- Cmd = lists:concat([Prog,
- " -detached ",
- TI#target_info.naming, " ", SlaveName,
- " -pa \"", Pa,"\"",
- NodeStarted,
- CrashArgs,
- " ", Args]),
- Opts = case start_node_get_option_value(env, OptList, []) of
- [] -> [];
- Env -> [{env, Env}]
- end,
- %% peer is always started on localhost
- %%
- %% Bad environment can cause open port to fail. If this happens,
- %% we ignore it and let the testcase handle the situation...
- catch open_port({spawn, Cmd}, [stream|Opts]),
-
- Tmo = 60000 * test_server:timetrap_scale_factor(),
-
- case start_node_get_option_value(wait, OptList, true) of
- true ->
- Ret = wait_for_node_started(LSock,Tmo,undefined,Cleanup,TI,self()),
- case {Ret,FailOnError} of
- {{{ok, Node}, Warning},_} ->
- gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning});
- {_,false} ->
- gen_server:reply(From,{Ret, HostStr, Cmd});
- {_,true} ->
- gen_server:reply(From,{fail,{Ret, HostStr, Cmd}})
- end;
- false ->
- Nodename = list_to_atom(SlaveName ++ "@" ++ HostStr),
- I = "=== Not waiting for node",
- gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}),
- Self = self(),
- spawn_link(
- fun() ->
- wait_for_node_started(LSock,Tmo,undefined,
- Cleanup,TI,Self),
- receive after infinity -> ok end
- end),
- ok
- end.
-
-%%
-%% Slave nodes are started on a remote host if
-%% - the option remote is given when calling test_server:start_node/3
-%%
-start_node_slave(SlaveName, OptList, From, TI) ->
- SuppliedArgs = start_node_get_option_value(args, OptList, []),
- Cleanup = start_node_get_option_value(cleanup, OptList, true),
-
- CrashFile = filename:join([TI#target_info.test_server_dir,
- "erl_crash_dump."++cast_to_list(SlaveName)]),
- CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]),
- Pa = TI#target_info.test_server_dir,
- Args = lists:concat([" -pa \"", Pa, "\" ", SuppliedArgs, CrashArgs]),
-
- Prog0 = start_node_get_option_value(erl, OptList, default),
- Prog = pick_erl_program(Prog0),
- Ret =
- case start_which_node(OptList) of
- {error,Reason} -> {{error,Reason},undefined,undefined};
- Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup)
- end,
- gen_server:reply(From,Ret).
-
-
-do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) ->
- Host =
- case Host0 of
- local -> test_server_sup:hoststr();
- _ -> cast_to_list(Host0)
- end,
- Cmd = Prog ++ " " ++ Args,
- case slave:start(Host, SlaveName, Args, no_link, Prog) of
- {ok,Nodename} ->
- case Cleanup of
- true -> ets:insert(slave_tab,#slave_info{name=Nodename});
- false -> ok
- end,
- {{ok,Nodename}, Host, Cmd, [], []};
- Ret ->
- {Ret, Host, Cmd}
- end.
-
-
-wait_for_node_started(LSock,Timeout,Client,Cleanup,TI,CtrlPid) ->
- case gen_tcp:accept(LSock,Timeout) of
- {ok,Sock} ->
- gen_tcp:close(LSock),
- receive
- {tcp,Sock,Started0} when is_binary(Started0) ->
- case unpack(Started0) of
- error ->
- gen_tcp:close(Sock),
- {error, connection_closed};
- {ok,Started} ->
- Version = TI#target_info.otp_release,
- VsnStr = TI#target_info.system_version,
- {ok,Nodename, W} =
- handle_start_node_return(Version,
- VsnStr,
- Started),
- case Cleanup of
- true ->
- ets:insert(slave_tab,#slave_info{name=Nodename,
- socket=Sock,
- client=Client});
- false -> ok
- end,
- gen_tcp:controlling_process(Sock,CtrlPid),
- test_server_ctrl:node_started(Nodename),
- {{ok,Nodename},W}
- end;
- {tcp_closed,Sock} ->
- gen_tcp:close(Sock),
- {error, connection_closed}
- after Timeout ->
- gen_tcp:close(Sock),
- {error, timeout}
- end;
- {error,Reason} ->
- gen_tcp:close(LSock),
- {error, {no_connection,Reason}}
- end.
-
-
-
-handle_start_node_return(Version,VsnStr,{started, Node, Version, VsnStr}) ->
- {ok, Node, []};
-handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) ->
- Str = io_lib:format("WARNING: Started node "
- "reports different system "
- "version than current node! "
- "Current node version: ~p, ~p "
- "Started node version: ~p, ~p",
- [Version, VsnStr,
- OVersion, OVsnStr]),
- Str1 = lists:flatten(Str),
- {ok, Node, Str1}.
-
-
-%%
-%% This function executes on the new node
-%%
-node_started([Host,PortAtom]) ->
- %% Must spawn a new process because the boot process should not
- %% hang forever!!
- spawn(fun() -> node_started(Host,PortAtom) end).
-
-%% This process hangs forever, just waiting for the socket to be
-%% closed and terminating the node
-node_started(Host,PortAtom) ->
- {_, Version} = init:script_id(),
- VsnStr = erlang:system_info(system_version),
- Port = list_to_integer(atom_to_list(PortAtom)),
- case catch gen_tcp:connect(Host,Port, [binary,
- {reuseaddr,true},
- {packet,2}]) of
-
- {ok,Sock} ->
- Started = term_to_binary({started, node(), Version, VsnStr}),
- ok = gen_tcp:send(Sock, [1|Started]),
- receive _Anyting ->
- gen_tcp:close(Sock),
- erlang:halt()
- end;
- _else ->
- erlang:halt()
- end.
-
-
-
-
-
-% start_which_node(Optlist) -> hostname
-start_which_node(Optlist) ->
- case start_node_get_option_value(remote, Optlist) of
- undefined ->
- local;
- true ->
- case find_remote_host() of
- {error, Other} ->
- {error, Other};
- RHost ->
- RHost
- end
- end.
-
-find_remote_host() ->
- HostList=test_server_ctrl:get_hosts(),
- case lists:delete(test_server_sup:hoststr(), HostList) of
- [] ->
- {error, no_remote_hosts};
- [RHost|_Rest] ->
- RHost
- end.
-
-start_node_get_option_value(Key, List) ->
- start_node_get_option_value(Key, List, undefined).
-
-start_node_get_option_value(Key, List, Default) ->
- case lists:keysearch(Key, 1, List) of
- {value, {Key, Value}} ->
- Value;
- false ->
- Default
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% stop_node(Name) -> ok | {error,Reason}
-%%
-%% Clean up - test_server will stop this node
-stop_node(Name) ->
- case ets:lookup(slave_tab,Name) of
- [#slave_info{}] ->
- ets:delete(slave_tab,Name),
- ok;
- [] ->
- {error, not_a_slavenode}
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% kill_nodes() -> ok
-%%
-%% Brutally kill all slavenodes that were not stopped by test_server
-kill_nodes() ->
- case ets:match_object(slave_tab,'_') of
- [] -> [];
- List ->
- lists:map(fun(SI) -> kill_node(SI) end, List)
- end.
-
-kill_node(SI) ->
- Name = SI#slave_info.name,
- ets:delete(slave_tab,Name),
- case SI#slave_info.socket of
- undefined ->
- catch rpc:call(Name,erlang,halt,[]);
- Sock ->
- gen_tcp:close(Sock)
- end,
- Name.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% cast_to_list(X) -> string()
-%%% X = list() | atom() | void()
-%%% Returns a string representation of whatever was input
-
-cast_to_list(X) when is_list(X) -> X;
-cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
-
-
-%%% L contains elements of the forms
-%%% {prog, String}
-%%% {release, Rel} where Rel = String | latest | previous
-%%% this
-%%%
-pick_erl_program(default) ->
- cast_to_list(lib:progname());
-pick_erl_program(L) ->
- P = random_element(L),
- case P of
- {prog, S} ->
- S;
- {release, S} ->
- find_release(S);
- this ->
- cast_to_list(lib:progname())
- end.
-
-%% This is an attempt to distinguish between spaces in the program
-%% path and spaces that separate arguments. The program is quoted to
-%% allow spaces in the path.
-%%
-%% Arguments could exist either if the executable is excplicitly given
-%% ({prog,String}) or if the -program switch to beam is used and
-%% includes arguments (typically done by cerl in OTP test environment
-%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
-%% could then typically be '/<full_path_to>/cerl -gcov').
-quote_progname(Progname) ->
- do_quote_progname(string:tokens(Progname," ")).
-
-do_quote_progname([Prog]) ->
- "\""++Prog++"\"";
-do_quote_progname([Prog,Arg|Args]) ->
- case os:find_executable(Prog) of
- false ->
- do_quote_progname([Prog++" "++Arg | Args]);
- _ ->
- %% this one has an executable - we assume the rest are arguments
- "\""++Prog++"\""++
- lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args]))
- end.
-
-random_element(L) ->
- random:seed(os:timestamp()),
- lists:nth(random:uniform(length(L)), L).
-
-find_release(latest) ->
- "/usr/local/otp/releases/latest/bin/erl";
-find_release(previous) ->
- "kaka";
-find_release(Rel) ->
- find_release(os:type(), Rel).
-
-find_release({unix,sunos}, Rel) ->
- case os:cmd("uname -p") of
- "sparc" ++ _ ->
- "/usr/local/otp/releases/otp_beam_solaris8_" ++ Rel ++ "/bin/erl";
- _ ->
- none
- end;
-find_release({unix,linux}, Rel) ->
- Candidates = find_rel_linux(Rel),
- case lists:dropwhile(fun(N) ->
- not filelib:is_regular(N)
- end, Candidates) of
- [] -> none;
- [Erl|_] -> Erl
- end;
-find_release(_, _) -> none.
-
-find_rel_linux(Rel) ->
- case suse_release() of
- none -> [];
- SuseRel -> find_rel_suse(Rel, SuseRel)
- end.
-
-find_rel_suse(Rel, SuseRel) ->
- Root = "/usr/local/otp/releases/sles",
- case SuseRel of
- "11" ->
- %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order.
- find_rel_suse_1(Rel, Root++"11") ++
- find_rel_suse_1(Rel, Root++"10") ++
- find_rel_suse_1(Rel, Root++"9");
- "10" ->
- %% Try both SuSE 10 and SuSe 9 in that order.
- find_rel_suse_1(Rel, Root++"10") ++
- find_rel_suse_1(Rel, Root++"9");
- "9" ->
- find_rel_suse_1(Rel, Root++"9");
- _ ->
- []
- end.
-
-find_rel_suse_1(Rel, RootWc) ->
- case erlang:system_info(wordsize) of
- 4 ->
- find_rel_suse_2(Rel, RootWc++"_32");
- 8 ->
- find_rel_suse_2(Rel, RootWc++"_64") ++
- find_rel_suse_2(Rel, RootWc++"_32")
- end.
-
-find_rel_suse_2(Rel, RootWc) ->
- RelDir = filename:dirname(RootWc),
- Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*",
- case file:list_dir(RelDir) of
- {ok,Dirs} ->
- case lists:filter(fun(Dir) ->
- case re:run(Dir, Pat) of
- nomatch -> false;
- _ -> true
- end
- end, Dirs) of
- [] ->
- [];
- [R|_] ->
- [filename:join([RelDir,R,"bin","erl"])]
- end;
- _ ->
- []
- end.
-
-%% suse_release() -> VersionString | none.
-%% Return the major SuSE version number for this platform or
-%% 'none' if this is not a SuSE platform.
-suse_release() ->
- case file:open("/etc/SuSE-release", [read]) of
- {ok,Fd} ->
- try
- suse_release(Fd)
- after
- file:close(Fd)
- end;
- {error,_} -> none
- end.
-
-suse_release(Fd) ->
- case io:get_line(Fd, '') of
- eof -> none;
- Line when is_list(Line) ->
- case re:run(Line, "^VERSION\\s*=\\s*(\\d+)\s*",
- [{capture,all_but_first,list}]) of
- nomatch ->
- suse_release(Fd);
- {match,[Version]} ->
- Version
- end
- end.
-
-unpack(Bin) ->
- {One,Term} = split_binary(Bin, 1),
- case binary_to_list(One) of
- [1] ->
- case catch {ok,binary_to_term(Term)} of
- {'EXIT',_} -> error;
- {ok,_}=Res -> Res
- end;
- _ -> error
- end.
-
-id(I) -> I.
-
-print_data(Port) ->
- receive
- {Port, {data, Bytes}} ->
- io:put_chars(Bytes),
- print_data(Port);
- {Port, eof} ->
- Port ! {self(), close},
- receive
- {Port, closed} ->
- true
- end,
- receive
- {'EXIT', Port, _} ->
- ok
- after 1 -> % force context switch
- ok
- end
- end.
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
deleted file mode 100644
index fc2cfd57bd..0000000000
--- a/lib/test_server/src/test_server_sup.erl
+++ /dev/null
@@ -1,939 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%%-------------------------------------------------------------------
-%%% Purpose: Test server support functions.
-%%%-------------------------------------------------------------------
--module(test_server_sup).
--export([timetrap/2, timetrap/3, timetrap/4,
- timetrap_cancel/1, capture_get/1, messages_get/1,
- timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0,
- cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
- get_username/0, get_os_family/0,
- hostatom/0, hostatom/1, hoststr/0, hoststr/1,
- framework_call/2,framework_call/3,framework_call/4,
- format_loc/1,
- util_start/0, util_stop/0, unique_name/0,
- call_trace/1,
- appup_test/1]).
--include("test_server_internal.hrl").
--define(crash_dump_tar,"crash_dumps.tar.gz").
--define(src_listing_ext, ".src.html").
--record(util_state, {starter, latest_name}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap(Timeout,Scale,Pid) -> Handle
-%% Handle = term()
-%%
-%% Creates a time trap, that will kill the given process if the
-%% trap is not cancelled with timetrap_cancel/1, within Timeout
-%% milliseconds.
-%% Scale says if the time should be scaled up to compensate for
-%% delays during the test (e.g. if cover is running).
-
-timetrap(Timeout0, Pid) ->
- timetrap(Timeout0, Timeout0, true, Pid).
-
-timetrap(Timeout0, Scale, Pid) ->
- timetrap(Timeout0, Timeout0, Scale, Pid).
-
-timetrap(Timeout0, ReportTVal, Scale, Pid) ->
- process_flag(priority, max),
- Timeout = if not Scale -> Timeout0;
- true -> test_server:timetrap_scale_factor() * Timeout0
- end,
- TruncTO = trunc(Timeout),
- receive
- after TruncTO ->
- kill_the_process(Pid, Timeout0, TruncTO, ReportTVal)
- end.
-
-kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) ->
- case is_process_alive(Pid) of
- true ->
- TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
- true -> ReportTVal end,
- MFLs = test_server:get_loc(Pid),
- Mon = erlang:monitor(process, Pid),
- Trap = {timetrap_timeout,TimeToReport,MFLs},
- exit(Pid, Trap),
- receive
- {'DOWN', Mon, process, Pid, _} ->
- ok
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- catch error_logger:warning_msg(
- "Testcase process ~w not "
- "responding to timetrap "
- "timeout:~n"
- " ~p.~n"
- "Killing testcase...~n",
- [Pid, Trap]),
- exit(Pid, kill)
- end;
- false ->
- ok
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap_cancel(Handle) -> ok
-%% Handle = term()
-%%
-%% Cancels a time trap.
-timetrap_cancel(Handle) ->
- unlink(Handle),
- MonRef = erlang:monitor(process, Handle),
- exit(Handle, kill),
- receive {'DOWN',MonRef,_,_,_} -> ok
- after
- 2000 ->
- erlang:demonitor(MonRef, [flush]),
- ok
- end.
-
-capture_get(Msgs) ->
- receive
- {captured,Msg} ->
- capture_get([Msg|Msgs])
- after 0 ->
- lists:reverse(Msgs)
- end.
-
-messages_get(Msgs) ->
- receive
- Msg ->
- messages_get([Msg|Msgs])
- after 0 ->
- lists:reverse(Msgs)
- end.
-
-timecall(M, F, A) ->
- {Elapsed, Val} = timer:tc(M, F, A),
- {Elapsed / 1000000, Val}.
-
-
-call_crash(Time,Crash,M,F,A) ->
- OldTrapExit = process_flag(trap_exit,true),
- Pid = spawn_link(M,F,A),
- Answer =
- receive
- {'EXIT',Crash} ->
- ok;
- {'EXIT',Pid,Crash} ->
- ok;
- {'EXIT',_Reason} when Crash==any ->
- ok;
- {'EXIT',Pid,_Reason} when Crash==any ->
- ok;
- {'EXIT',Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
- [Crash, Reason]),
- exit({wrong_crash_reason,Reason});
- {'EXIT',Pid,Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
- [Crash, Reason]),
- exit({wrong_crash_reason,Reason});
- {'EXIT',OtherPid,Reason} when OldTrapExit == false ->
- exit({'EXIT',OtherPid,Reason})
- after do_trunc(Time) ->
- exit(call_crash_timeout)
- end,
- process_flag(trap_exit,OldTrapExit),
- Answer.
-
-do_trunc(infinity) -> infinity;
-do_trunc(T) -> trunc(T).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% app_test/2
-%%
-%% Checks one applications .app file for obvious errors.
-%% Checks..
-%% * .. required fields
-%% * .. that all modules specified actually exists
-%% * .. that all requires applications exists
-%% * .. that no module included in the application has export_all
-%% * .. that all modules in the ebin/ dir is included
-%% (This only produce a warning, as all modules does not
-%% have to be included (If the `pedantic' option isn't used))
-app_test(Application, Mode) ->
- case is_app(Application) of
- {ok, AppFile} ->
- do_app_tests(AppFile, Application, Mode);
- Error ->
- test_server:fail(Error)
- end.
-
-is_app(Application) ->
- case file:consult(filename:join([code:lib_dir(Application),"ebin",
- atom_to_list(Application)++".app"])) of
- {ok, [{application, Application, AppFile}] } ->
- {ok, AppFile};
- _ ->
- test_server:format(minor,
- "Application (.app) file not found, "
- "or it has very bad syntax.~n"),
- {error, not_an_application}
- end.
-
-
-do_app_tests(AppFile, AppName, Mode) ->
- DictList=
- [
- {missing_fields, []},
- {missing_mods, []},
- {superfluous_mods_in_ebin, []},
- {export_all_mods, []},
- {missing_apps, []}
- ],
- fill_dictionary(DictList),
-
- %% An appfile must (?) have some fields..
- check_fields([description, modules, registered, applications], AppFile),
-
- %% Check for missing and extra modules.
- {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile),
- EBinList=lists:sort(get_ebin_modnames(AppName)),
- {Missing, Extra} = common(lists:sort(Mods), EBinList),
- put(superfluous_mods_in_ebin, Extra),
- put(missing_mods, Missing),
-
- %% Check that no modules in the application has export_all.
- app_check_export_all(Mods),
-
- %% Check that all specified applications exists.
- {value, {applications, Apps}}=
- lists:keysearch(applications, 1, AppFile),
- check_apps(Apps),
-
- A=check_dict(missing_fields, "Inconsistent app file, "
- "missing fields"),
- B=check_dict(missing_mods, "Inconsistent app file, "
- "missing modules"),
- C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, "
- "Modules not included in app file.", Mode),
- D=check_dict(export_all_mods, "Inconsistent app file, "
- "Modules have `export_all'."),
- E=check_dict(missing_apps, "Inconsistent app file, "
- "missing applications."),
-
- erase_dictionary(DictList),
- case A+B+C+D+E of
- 5 ->
- ok;
- _ ->
- test_server:fail()
- end.
-
-app_check_export_all([]) ->
- ok;
-app_check_export_all([Mod|Mods]) ->
- case catch apply(Mod, module_info, [compile]) of
- {'EXIT', {undef,_}} ->
- app_check_export_all(Mods);
- COpts ->
- case lists:keysearch(options, 1, COpts) of
- false ->
- app_check_export_all(Mods);
- {value, {options, List}} ->
- case lists:member(export_all, List) of
- true ->
- put(export_all_mods, [Mod|get(export_all_mods)]),
- app_check_export_all(Mods);
- false ->
- app_check_export_all(Mods)
- end
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% appup_test/1
-%%
-%% Checks one applications .appup file for obvious errors.
-%% Checks..
-%% * .. syntax
-%% * .. that version in app file matches appup file version
-%% * .. validity of appup instructions
-%%
-%% For library application this function checks that the proper
-%% 'restart_application' upgrade and downgrade clauses exist.
-appup_test(Application) ->
- case is_app(Application) of
- {ok, AppFile} ->
- case is_appup(Application, proplists:get_value(vsn, AppFile)) of
- {ok, Up, Down} ->
- StartMod = proplists:get_value(mod, AppFile),
- Modules = proplists:get_value(modules, AppFile),
- do_appup_tests(StartMod, Application, Up, Down, Modules);
- Error ->
- test_server:fail(Error)
- end;
- Error ->
- test_server:fail(Error)
- end.
-
-is_appup(Application, Version) ->
- AppupFile = atom_to_list(Application) ++ ".appup",
- AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]),
- case file:consult(AppupPath) of
- {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) ->
- {ok, Up, Down};
- _ ->
- test_server:format(
- minor,
- "Application upgrade (.appup) file not found, "
- "or it has very bad syntax.~n"),
- {error, appup_not_readable}
- end.
-
-do_appup_tests(undefined, Application, Up, Down, _Modules) ->
- %% library application
- case Up of
- [{<<".*">>, [{restart_application, Application}]}] ->
- case Down of
- [{<<".*">>, [{restart_application, Application}]}] ->
- ok;
- _ ->
- test_server:format(
- minor,
- "Library application needs restart_application "
- "downgrade instruction.~n"),
- {error, library_downgrade_instruction_malformed}
- end;
- _ ->
- test_server:format(
- minor,
- "Library application needs restart_application "
- "upgrade instruction.~n"),
- {error, library_upgrade_instruction_malformed}
- end;
-do_appup_tests(_, _Application, Up, Down, Modules) ->
- %% normal application
- case check_appup_clauses_plausible(Up, up, Modules) of
- ok ->
- case check_appup_clauses_plausible(Down, down, Modules) of
- ok ->
- test_server:format(minor, "OK~n");
- Error ->
- test_server:format(minor, "ERROR ~p~n", [Error]),
- test_server:fail(Error)
- end;
- Error ->
- test_server:format(minor, "ERROR ~p~n", [Error]),
- test_server:fail(Error)
- end.
-
-check_appup_clauses_plausible([], _Direction, _Modules) ->
- ok;
-check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules)
- when is_binary(Re) ->
- case re:compile(Re) of
- {ok, _} ->
- case check_appup_instructions(Instrs, Direction, Modules) of
- ok ->
- check_appup_clauses_plausible(Rest, Direction, Modules);
- Error ->
- Error
- end;
- {error, Error} ->
- {error, {version_regex_malformed, Re, Error}}
- end;
-check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules)
- when is_list(V) ->
- case check_appup_instructions(Instrs, Direction, Modules) of
- ok ->
- check_appup_clauses_plausible(Rest, Direction, Modules);
- Error ->
- Error
- end;
-check_appup_clauses_plausible(Clause, _Direction, _Modules) ->
- {error, {clause_malformed, Clause}}.
-
-check_appup_instructions(Instrs, Direction, Modules) ->
- case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of
- {_Good, []} ->
- ok;
- {_, Bad} ->
- {error, {bad_instructions, Bad}}
- end.
-
-check_instructions(_, [], _, Good, Bad, _) ->
- {lists:reverse(Good), lists:reverse(Bad)};
-check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) ->
- case catch check_instruction(UpDown, Instr, All, Modules) of
- ok ->
- check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules);
- {error, Reason} ->
- NewBad = [{Instr, Reason} | Bad],
- check_instructions(UpDown, Rest, All, Good, NewBad, Modules)
- end.
-
-check_instruction(up, {add_module, Module}, _, Modules) ->
- %% A new module is added
- check_module(Module, Modules);
-check_instruction(down, {add_module, Module}, _, Modules) ->
- %% An old module is re-added
- case (catch check_module(Module, Modules)) of
- {error, {unknown_module, Module, Modules}} -> ok;
- ok -> throw({error, {existing_readded_module, Module}})
- end;
-check_instruction(_, {load_module, Module}, _, Modules) ->
- check_module(Module, Modules);
-check_instruction(_, {load_module, Module, DepMods}, _, Modules) ->
- check_module(Module, Modules),
- check_depend(DepMods);
-check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) ->
- check_module(Module, Modules),
- check_depend(DepMods),
- check_purge(Pre),
- check_purge(Post);
-check_instruction(up, {delete_module, Module}, _, Modules) ->
- case (catch check_module(Module, Modules)) of
- {error, {unknown_module, Module, Modules}} ->
- ok;
- ok ->
- throw({error,{existing_module_deleted, Module}})
- end;
-check_instruction(down, {delete_module, Module}, _, Modules) ->
- check_module(Module, Modules);
-check_instruction(_, {update, Module}, _, Modules) ->
- check_module(Module, Modules);
-check_instruction(_, {update, Module, supervisor}, _, Modules) ->
- check_module(Module, Modules);
-check_instruction(_, {update, Module, DepMods}, _, Modules)
- when is_list(DepMods) ->
- check_module(Module, Modules);
-check_instruction(_, {update, Module, Change}, _, Modules) ->
- check_module(Module, Modules),
- check_change(Change);
-check_instruction(_, {update, Module, Change, DepMods}, _, Modules) ->
- check_module(Module, Modules),
- check_change(Change),
- check_depend(DepMods);
-check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) ->
- check_module(Module, Modules),
- check_change(Change),
- check_purge(Pre),
- check_purge(Post),
- check_depend(DepMods);
-check_instruction(_,
- {update, Module, Timeout, Change, Pre, Post, DepMods},
- _,
- Modules) ->
- check_module(Module, Modules),
- check_timeout(Timeout),
- check_change(Change),
- check_purge(Pre),
- check_purge(Post),
- check_depend(DepMods);
-check_instruction(_,
- {update, Module, ModType, Timeout, Change, Pre, Post, DepMods},
- _,
- Modules) ->
- check_module(Module, Modules),
- check_mod_type(ModType),
- check_timeout(Timeout),
- check_change(Change),
- check_purge(Pre),
- check_purge(Post),
- check_depend(DepMods);
-check_instruction(_, {restart_application, Application}, _, _) ->
- check_application(Application);
-check_instruction(_, {remove_application, Application}, _, _) ->
- check_application(Application);
-check_instruction(_, {add_application, Application}, _, _) ->
- check_application(Application);
-check_instruction(_, {add_application, Application, Type}, _, _) ->
- check_application(Application),
- check_restart_type(Type);
-check_instruction(_, Instr, _, _) ->
- throw({error, {low_level_or_invalid_instruction, Instr}}).
-
-check_module(Module, Modules) ->
- case {is_atom(Module), lists:member(Module, Modules)} of
- {true, true} -> ok;
- {true, false} -> throw({error, {unknown_module, Module}});
- {false, _} -> throw({error, {bad_module, Module}})
- end.
-
-check_application(App) ->
- case is_atom(App) of
- true -> ok;
- false -> throw({error, {bad_application, App}})
- end.
-
-check_depend(Dep) when is_list(Dep) -> ok;
-check_depend(Dep) -> throw({error, {bad_depend, Dep}}).
-
-check_restart_type(permanent) -> ok;
-check_restart_type(transient) -> ok;
-check_restart_type(temporary) -> ok;
-check_restart_type(load) -> ok;
-check_restart_type(none) -> ok;
-check_restart_type(Type) -> throw({error, {bad_restart_type, Type}}).
-
-check_timeout(T) when is_integer(T), T > 0 -> ok;
-check_timeout(default) -> ok;
-check_timeout(infinity) -> ok;
-check_timeout(T) -> throw({error, {bad_timeout, T}}).
-
-check_mod_type(static) -> ok;
-check_mod_type(dynamic) -> ok;
-check_mod_type(Type) -> throw({error, {bad_mod_type, Type}}).
-
-check_purge(soft_purge) -> ok;
-check_purge(brutal_purge) -> ok;
-check_purge(Purge) -> throw({error, {bad_purge, Purge}}).
-
-check_change(soft) -> ok;
-check_change({advanced, _}) -> ok;
-check_change(Change) -> throw({error, {bad_change, Change}}).
-
-%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1},
-%% NotInL2 is the elements of L1 which don't occurr in L2,
-%% NotInL1 is the elements of L2 which don't ocurr in L1.
-
-common(L1, L2) ->
- common(L1, L2, [], []).
-
-common([X|Rest1], [X|Rest2], A1, A2) ->
- common(Rest1, Rest2, A1, A2);
-common([X|Rest1], [Y|Rest2], A1, A2) when X < Y ->
- common(Rest1, [Y|Rest2], [X|A1], A2);
-common([X|Rest1], [Y|Rest2], A1, A2) ->
- common([X|Rest1], Rest2, A1, [Y|A2]);
-common([], L, A1, A2) ->
- {A1, L++A2};
-common(L, [], A1, A2) ->
- {L++A1, A2}.
-
-check_apps([]) ->
- ok;
-check_apps([App|Apps]) ->
- case is_app(App) of
- {ok, _AppFile} ->
- ok;
- {error, _} ->
- put(missing_apps, [App|get(missing_apps)])
- end,
- check_apps(Apps).
-
-check_fields([], _AppFile) ->
- ok;
-check_fields([L|Ls], AppFile) ->
- check_field(L, AppFile),
- check_fields(Ls, AppFile).
-
-check_field(FieldName, AppFile) ->
- case lists:keymember(FieldName, 1, AppFile) of
- true ->
- ok;
- false ->
- put(missing_fields, [FieldName|get(missing_fields)]),
- ok
- end.
-
-check_dict(Dict, Reason) ->
- case get(Dict) of
- [] ->
- 1; % All ok.
- List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
- 0
- end.
-
-check_dict_tolerant(Dict, Reason, Mode) ->
- case get(Dict) of
- [] ->
- 1; % All ok.
- List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
- case Mode of
- pedantic ->
- 0;
- _ ->
- 1
- end
- end.
-
-get_ebin_modnames(AppName) ->
- Wc=filename:join([code:lib_dir(AppName),"ebin",
- "*"++code:objfile_extension()]),
- TheFun=fun(X, Acc) ->
- [list_to_atom(filename:rootname(
- filename:basename(X)))|Acc] end,
- _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)).
-
-%%
-%% This function removes any erl_crash_dump* files found in the
-%% test server directory. Done only once when the test server
-%% is started.
-%%
-cleanup_crash_dumps() ->
- Dir = crash_dump_dir(),
- Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
- delete_files(Dumps).
-
-crash_dump_dir() ->
- filename:dirname(code:which(?MODULE)).
-
-tar_crash_dumps() ->
- Dir = crash_dump_dir(),
- case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of
- [] -> {error,no_crash_dumps};
- Dumps ->
- TarFileName = filename:join(Dir,?crash_dump_tar),
- {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]),
- lists:foreach(
- fun(File) ->
- ok = erl_tar:add(Tar,File,filename:basename(File),[])
- end,
- Dumps),
- ok = erl_tar:close(Tar),
- delete_files(Dumps),
- {ok,TarFileName}
- end.
-
-
-check_new_crash_dumps() ->
- Dir = crash_dump_dir(),
- Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
- case length(Dumps) of
- 0 ->
- ok;
- Num ->
- test_server_ctrl:format(minor,
- "Found ~w crash dumps:~n", [Num]),
- append_files_to_logfile(Dumps),
- delete_files(Dumps)
- end.
-
-append_files_to_logfile([]) -> ok;
-append_files_to_logfile([File|Files]) ->
- NodeName=from($., File),
- test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]),
- Fd=get(test_server_minor_fd),
- case file:read_file(File) of
- {ok, Bin} ->
- case file:write(Fd, Bin) of
- ok ->
- ok;
- {error,Error} ->
- %% Write failed. The following io:format/3 will probably also
- %% fail, but in that case it will throw an exception so that
- %% we will be aware of the problem.
- io:format(Fd, "Unable to write the crash dump "
- "to this file: ~p~n", [file:format_error(Error)])
- end;
- _Error ->
- io:format(Fd, "Failed to read: ~ts\n", [File])
- end,
- append_files_to_logfile(Files).
-
-delete_files([]) -> ok;
-delete_files([File|Files]) ->
- io:format("Deleting file: ~ts~n", [File]),
- case file:delete(File) of
- {error, _} ->
- case file:rename(File, File++".old") of
- {error, Error} ->
- io:format("Could neither delete nor rename file "
- "~ts: ~ts.~n", [File, Error]);
- _ ->
- ok
- end;
- _ ->
- ok
- end,
- delete_files(Files).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% erase_dictionary(Vars) -> ok
-%% Vars = [atom(),...]
-%%
-%% Takes a list of dictionary keys, KeyVals, erases
-%% each key and returns ok.
-erase_dictionary([{Var, _Val}|Vars]) ->
- erase(Var),
- erase_dictionary(Vars);
-erase_dictionary([]) ->
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% fill_dictionary(KeyVals) -> void()
-%% KeyVals = [{atom(),term()},...]
-%%
-%% Takes each Key-Value pair, and inserts it in the process dictionary.
-fill_dictionary([{Var,Val}|Vars]) ->
- put(Var,Val),
- fill_dictionary(Vars);
-fill_dictionary([]) ->
- [].
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_username() -> UserName
-%%
-%% Returns the current user
-get_username() ->
- getenv_any(["USER","USERNAME"]).
-
-getenv_any([Key|Rest]) ->
- case catch os:getenv(Key) of
- String when is_list(String) -> String;
- false -> getenv_any(Rest)
- end;
-getenv_any([]) -> "".
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_os_family() -> OsFamily
-%%
-%% Returns the OS family
-get_os_family() ->
- {OsFamily,_OsName} = os:type(),
- OsFamily.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% hostatom()/hostatom(Node) -> Host; atom()
-%% hoststr() | hoststr(Node) -> Host; string()
-%%
-%% Returns the OS family
-hostatom() ->
- hostatom(node()).
-hostatom(Node) ->
- list_to_atom(hoststr(Node)).
-hoststr() ->
- hoststr(node()).
-hoststr(Node) when is_atom(Node) ->
- hoststr(atom_to_list(Node));
-hoststr(Node) when is_list(Node) ->
- from($@, Node).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(_H, []) -> [].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn
-%%
-%% Calls the given Func in Callback
-framework_call(Func,Args) ->
- framework_call(Func,Args,ok).
-framework_call(Func,Args,DefaultReturn) ->
- CB = os:getenv("TEST_SERVER_FRAMEWORK"),
- framework_call(CB,Func,Args,DefaultReturn).
-framework_call(FW,_Func,_Args,DefaultReturn)
- when FW =:= false; FW =:= "undefined" ->
- DefaultReturn;
-framework_call(Callback,Func,Args,DefaultReturn) ->
- Mod = list_to_atom(Callback),
- case code:is_loaded(Mod) of
- false -> code:load_file(Mod);
- _ -> ok
- end,
- case erlang:function_exported(Mod,Func,length(Args)) of
- true ->
- EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end,
- SetTcState = case Func of
- end_tc -> true;
- init_tc -> true;
- _ -> false
- end,
- case SetTcState of
- true ->
- test_server:set_tc_state({framework,Mod,Func});
- false ->
- ok
- end,
- try apply(Mod,Func,Args) of
- Result ->
- Result
- catch
- exit:Why ->
- EH(Why);
- error:Why ->
- EH({Why,erlang:get_stacktrace()});
- throw:Why ->
- EH(Why)
- end;
- false ->
- DefaultReturn
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% format_loc(Loc) -> string()
-%%
-%% Formats the printout of the line of code read from
-%% process dictionary (test_server_loc). Adds link to
-%% correct line in source code.
-format_loc([{Mod,Func,Line}]) ->
- [format_loc1({Mod,Func,Line})];
-format_loc([{Mod,Func,Line}|Rest]) ->
- ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
-format_loc([{Mod,LineOrFunc}]) ->
- format_loc({Mod,LineOrFunc});
-format_loc({Mod,Func}) when is_atom(Func) ->
- io_lib:format("{~w,~w}",[Mod,Func]);
-format_loc(Loc) ->
- io_lib:format("~p",[Loc]).
-
-format_loc1([{Mod,Func,Line}]) ->
- [" ",format_loc1({Mod,Func,Line}),"]"];
-format_loc1([{Mod,Func,Line}|Rest]) ->
- [" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
-format_loc1({Mod,Func,Line}) ->
- ModStr = atom_to_list(Mod),
- case {lists:member(no_src, get(test_server_logopts)),
- lists:reverse(ModStr)} of
- {false,[$E,$T,$I,$U,$S,$_|_]} ->
- Link = if is_integer(Line) ->
- integer_to_list(Line);
- Line == last_expr ->
- list_to_atom(atom_to_list(Func)++"-last_expr");
- is_atom(Line) ->
- atom_to_list(Line);
- true ->
- Line
- end,
- io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}",
- [Mod,Func,
- test_server_ctrl:uri_encode(downcase(ModStr)),
- ?src_listing_ext,Link,Line]);
- _ ->
- io_lib:format("{~w,~w,~w}",[Mod,Func,Line])
- end.
-
-downcase(S) -> downcase(S, []).
-downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
- downcase(Rest, [Uc-$A+$a|Result]);
-downcase([C|Rest], Result) ->
- downcase(Rest, [C|Result]);
-downcase([], Result) ->
- lists:reverse(Result).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_start() -> ok
-%%
-%% Start local utility process
-util_start() ->
- Starter = self(),
- case whereis(?MODULE) of
- undefined ->
- spawn_link(fun() ->
- register(?MODULE, self()),
- util_loop(#util_state{starter=Starter})
- end);
- _Pid ->
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_stop() -> ok
-%%
-%% Stop local utility process
-util_stop() ->
- try (?MODULE ! {self(),stop}) of
- _ ->
- receive {?MODULE,stopped} -> ok
- after 5000 -> exit(whereis(?MODULE), kill)
- end
- catch
- _:_ ->
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% unique_name() -> string()
-%%
-unique_name() ->
- ?MODULE ! {self(),unique_name},
- receive {?MODULE,Name} -> Name
- after 5000 -> exit({?MODULE,no_util_process})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_loop(State) -> ok
-%%
-util_loop(State) ->
- receive
- {From,unique_name} ->
- Nr = erlang:unique_integer([positive]),
- Name = integer_to_list(Nr),
- if Name == State#util_state.latest_name ->
- timer:sleep(1),
- self() ! {From,unique_name},
- util_loop(State);
- true ->
- From ! {?MODULE,Name},
- util_loop(State#util_state{latest_name = Name})
- end;
- {From,stop} ->
- catch unlink(State#util_state.starter),
- From ! {?MODULE,stopped},
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% call_trace(TraceSpecFile) -> ok
-%%
-%% Read terms on format {m,Mod} | {f,Mod,Func}
-%% from TraceSpecFile and enable call trace for
-%% specified functions.
-call_trace(TraceSpec) ->
- case catch try_call_trace(TraceSpec) of
- {'EXIT',Reason} ->
- erlang:display(Reason),
- exit(Reason);
- Ok ->
- Ok
- end.
-
-try_call_trace(TraceSpec) ->
- case file:consult(TraceSpec) of
- {ok,Terms} ->
- dbg:tracer(),
- %% dbg:p(self(), [p, m, sos, call]),
- dbg:p(self(), [sos, call]),
- lists:foreach(fun({m,M}) ->
- case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of
- {error,What} -> exit({error,{tracing_failed,What}});
- _ -> ok
- end;
- ({f,M,F}) ->
- case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of
- {error,What} -> exit({error,{tracing_failed,What}});
- _ -> ok
- end;
- (Huh) ->
- exit({error,{unrecognized_trace_term,Huh}})
- end, Terms),
- ok;
- {_,Error} ->
- exit({error,{tracing_failed,TraceSpec,Error}})
- end.
-
diff --git a/lib/test_server/src/things/distr_startup_SUITE.erl b/lib/test_server/src/things/distr_startup_SUITE.erl
deleted file mode 100644
index aa84ab007f..0000000000
--- a/lib/test_server/src/things/distr_startup_SUITE.erl
+++ /dev/null
@@ -1,239 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(distr_startup_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [reads,writes].
-
--define(iterations,10000).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-app1() ->
- {application, app1,
- [{description, "ERTS CXC 138 10"},
- {vsn, "2.0"},
- {applications, [kernel, stdlib]},
- {mod, {ch_sup, {app1, 1, 3}}}]}.
-
-app3() ->
- {application, app3,
- [{description, "ERTS CXC 138 10"},
- {vsn, "2.0"},
- {applications, [kernel, stdlib]},
- {mod, {ch_sup, {app3, 7, 9}}}]}.
-
-
-config(Fd,C1,C2,C3) ->
- io:format(Fd,
- "[{kernel, [{sync_nodes_optional, ['~s','~s','~s']},"
- "{sync_nodes_timeout, 1},"
- "{distributed, [{app1, ['~s', '~s', '~s']},"
- "{app2, 10000, ['~s', '~s', '~s']},"
- "{app3, 5000, [{'~s', '~s'}, '~s']}]}]}].~n",
- [C1,C2,C3, C1,C2,C3, C1,C2,C3, C1,C2,C3]).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(H, []) -> [].
-
-%%-----------------------------------------------------------------
-%% Test suite for distributed applications, tests start, load
-%% etc indirectly.
-%% Should be started in a CC view with:
-%% erl -sname master -rsh ctrsh
-%%-----------------------------------------------------------------
-start_nodes(Conf) ->
- % Write a config file
- ?line Nodes = ?config(nodes,Conf),
- ?line [C1,C2,C3|_] = Nodes, %% Need at least 3 nodes
- ?line Dir = ?config(priv_dir,Conf),
- ?line {ok, Fd} = file:open(Dir ++ "sys.config", write),
- ?line config(Fd,C1,C2,C3),
- ?line file:close(Fd),
- ?line Config = Dir ++ "sys",
-
- % Test [cp1, cp2, cp3]
- ?line {ok, Cp1} = start_node(lists:nth(1,Nodes), Config),
- ?line {ok, Cp2} = start_node(lists:nth(2,Nodes), Config),
- ?line {ok, Cp3} = start_node(lists:nth(3,Nodes), Config),
- % Start app1 and make sure cp1 starts it
- %%?line rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]),
- %%?line rpc:multicall([Cp1, Cp2, Cp3], application, start,[app1,permanent]),
- ?line test_server:sleep(1000),
- {Cp1,Cp2,Cp3}.
-
-stop_nodes({Cp1,Cp2,Cp3}) ->
- ?line stop_node(Cp1),
- ?line stop_node(Cp2),
- ?line stop_node(Cp3).
-
-start_node(NodeAtHost, Config) ->
- ?line NodeAtHostStr = atom_to_list(NodeAtHost),
- ?line HostStr = from($@,NodeAtHostStr),
- ?line NodeStr = lists:reverse(from($@,lists:reverse(NodeAtHostStr))),
- ?line Host = list_to_atom(HostStr),
- ?line Node = list_to_atom(NodeStr),
- ?line io:format("Launching slave node ~p@~p ~p",[Node,Host,Config]),
- ?line slave:start(Host, Node, lists:concat(["-config ", Config])).
-
-stop_node(Node) ->
- ?line rpc:cast(Node, erlang, halt, []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-start_client_process(Cp,Mode,NodeNum) ->
- io:format("Starting client process at ~p in mode ~p",[Cp,Mode]),
- ?line case rpc:call(Cp, erlang, spawn,
- [?MODULE, client,
- [Mode,NodeNum,self(),random:uniform(1000)]]) of
- {badrpc,Reason} ->
- ?line exit({badrpc,{Cp,Reason}});
- Client ->
- ?line Client
- end.
-
-start_clients(Mode,Conf) ->
- ?line random:seed(4711,0,0),
- ?line {Cp1,Cp2,Cp3} = start_nodes(Conf),
- ?line Client1 = start_client_process(Cp1,Mode,1),
- ?line Client2 = start_client_process(Cp2,Mode,2),
- ?line Client3 = start_client_process(Cp3,Mode,3),
- test_server:format(1,"All 3 nodes started, "
- "power off client(s) any time...",[]),
- Client1 ! go,
- Client2 ! go,
- Client3 ! go,
- {{Cp1,Cp2,Cp3},{Client1,Client2,Client3}}.
-
-stop_clients(Cps) ->
- test_server:format(1,"Test completed.",[]),
- ?line stop_nodes(Cps).
-
-data() ->
- {{self(),foo,bar,[1,2,3,4,5,6,7],{{{{}}}},
- "We need pretty long packages, so that there is a big risk "
- "of cutting it in the middle when suddenly turning off "
- "the power or breaking the connection. "
- "We don't check the contents of the data very much, but "
- "at least there is a magic cookie at the end (123456)."
- "If that one arrives correctly, the link is ok as far "
- "as we are concerned."},
- 123456}.
-
-reads(suite) -> [];
-reads(Conf) ->
- ?line {Cps,_} = start_clients(w,Conf),
- ?line read_loop(?iterations,0),
- ?line stop_clients(Cps),
- ok.
-
-read_loop(0,M) ->
- ok;
-read_loop(N,M) ->
- ?line Dog = test_server:timetrap(test_server:seconds(0.5)),
- M2 =
- receive
- {Node,Count,{_,123456}} ->
- ?line setelement(Node,M,element(Node,M)+1);
- {Node,Count,Data} ->
- ?line exit({network_transmission_error,Data});
- {nodedown,Node} ->
- ?line test_server:format(1,"Node ~s went down",[Node]),
- ?line M;
- Other ->
- ?line M
- after test_server:seconds(0.1) ->
- ?line io:format("No message!"),
- ?line M
- end,
- ?line test_server:timetrap_cancel(Dog),
- ?line M3 =
- case N rem 100 of
- 0 -> io:format("~p reads to go (~w msgs)",[N,M2]),
- {0,0,0};
- _ -> M2
- end,
- ?line read_loop(N-1,M3).
-
-client(w,NodeNum,Pid,Seed) ->
- random:seed(Seed,0,0),
- receive
- go -> ok
- end,
- client_write_loop(Pid,0,NodeNum,data());
-client(r,NodeNum,Pid,Seed) ->
- random:seed(Seed,0,0),
- receive
- go -> ok
- end,
- client_read_loop(0).
-
-client_write_loop(Pid,N,NodeNum,Data) ->
- test_server:sleep(random:uniform(20)),
- Pid ! {NodeNum,N,Data},
- client_write_loop(Pid,N+1,NodeNum,Data).
-
-writes(suite) -> [];
-writes(Conf) ->
- ?line {Cps,{C1,C2,C3}} = start_clients(r,Conf),
- ?line write_loop(2*?iterations,{C1,C2,C3},data()),
- ?line stop_clients(Cps),
- ok.
-
-write_loop(0,_,_) ->
- ok;
-write_loop(N,Clients,Data) ->
- ?line Dog = test_server:timetrap(test_server:seconds(0.5)),
- ?line Client = element(random:uniform(size(Clients)),Clients),
- ?line Client ! {node(),N,Data},
- ?line test_server:timetrap_cancel(Dog),
- receive
- {nodedown,Node} ->
- ?line test_server:format(1,"Node ~s went down",[Node])
- after 0 ->
- ?line ok
- end,
- ?line case N rem 100 of
- 0 -> io:format("~p writes to go",[N]);
- _ -> ok
- end,
- ?line write_loop(N-1,Clients,Data).
-
-client_read_loop(N) ->
- receive
- {Node,Count,{_,123456}} ->
- ?line ok;
- {Node,Count,Data} ->
- ?line io:format("~p(~p): transmission error from node ~p(~p): ~p",
- [node(),N,Node,Count,Data]);
- Other ->
- ?line io:format("~p(~p): got a strange message: ~p",
- [node(),N,Other])
- end,
- client_read_loop(N+1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/test_server/src/things/mnesia_power_SUITE.erl b/lib/test_server/src/things/mnesia_power_SUITE.erl
deleted file mode 100644
index e9bc75e583..0000000000
--- a/lib/test_server/src/things/mnesia_power_SUITE.erl
+++ /dev/null
@@ -1,126 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(mnesia_power_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [run].
-
--define(iterations,3). %% nof power-off cycles to do before acceptance
--define(rows,8). %% nof database rows to use (not too big, please)
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--record(sum_table_1,{row,a,b,c,s}).
-
-run(suite) -> [];
-run(Config) ->
- ?line mnesia:create_schema([node()]),
- ?line mnesia:start(),
- ?line mnesia:create_table([{name, sum_table_1}, {disc_copies,[node()]},
- {attributes,record_info(fields,sum_table_1)}]),
- ?line run_test(Config,?iterations).
-
-run(Config,N) ->
- ?line mnesia:start(),
- ?line check_consistency(sum_table_1),
- case N of
- 0 -> ?line ok;
- N -> ?line run_test(Config,N)
- end.
-
-run_test(Config,N) ->
- ?line Pid1a = start_manipulator(sum_table_1),
- ?line Pid1b = start_manipulator(sum_table_1),
- ?line Pid1c = start_manipulator(sum_table_1),
- ?line test_server:resume_point(?MODULE,run,[Config,N-1]),
- ?line test_server:format(1,"Manipulating data like crazy now, "
- "power off any time..."),
- ?line test_server:sleep(infinity).
-
-start_manipulator(Table) ->
- ?line spawn_link(?MODULE,manipulator_init,[Table]).
-
-manipulator_init(Table) ->
- random:seed(4711,0,0),
- manipulator(0,Table).
-
-manipulator(N,Table) ->
- ?line Fun =
- fun() ->
- ?line Row = random:uniform(?rows),
- ?line A = random:uniform(100000),
- ?line B = random:uniform(100000),
- ?line C = random:uniform(100000),
- ?line Sum = A+B+C,
- ?line case mnesia:write(#sum_table_1
- {row=Row,a=A,b=B,c=C,s=Sum}) of
- ok -> ok;
- Other ->
- ?line io:format("Trans failed: ~p\n",[Other])
- end
- end,
- ?line mnesia:transaction(Fun),
- case mnesia:table_info(sum_table_1,size) of
- 0 -> exit(still_empty);
- _ -> ok
- end,
- case N rem 2000 of
- 0 -> io:format("~p did ~p operations",[self(),N]),
- check_consistency(sum_table_1);
- _ -> ok
- end,
- ?line manipulator(N+1,Table).
-
-check_consistency(Table) ->
- io:format("Checking consistency of table ~p\n",[Table]),
- All = mnesia:table_info(Table,wild_pattern),
- ?line Fun =
- fun() ->
- mnesia:match_object(All)
- end,
- ?line case mnesia:transaction(Fun) of
- {atomic,Val} ->
- check_consistency_rows(Val,0);
- Other ->
- io:format("Trans failed: ~p\n",[Other]),
- exit(failed),
- check_consistency(Table)
- end.
-
-check_consistency_rows([#sum_table_1{a=A,b=B,c=C,s=Sum}|Rows],N) ->
- ?line Sum=A+B+C,
- ?line check_consistency_rows(Rows,N+1);
-check_consistency_rows([],N) ->
- io:format("All ~p rows were consistent\n",[N]),
- {ok,N};
-check_consistency_rows(Thing,N) ->
- io:format("Mnesia transaction returned:\n~p\n",[Thing]),
- exit({bad_format,Thing}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-
-
-
diff --git a/lib/test_server/src/things/random_kill_SUITE.erl b/lib/test_server/src/things/random_kill_SUITE.erl
deleted file mode 100644
index 917bc2b3d5..0000000000
--- a/lib/test_server/src/things/random_kill_SUITE.erl
+++ /dev/null
@@ -1,82 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(random_kill_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [run].
-
--define(iterations,25). %% Kill this many processes,
- %% possibly with reboots in between
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-run(suite) -> [];
-run(Config) ->
- registered(?iterations).
-
-registered(0) ->
- ok;
-registered(N) ->
- random:seed(3461*N,1159*N,351*N),
- Pid = select_victim(registered),
- test_server:resume_point(?MODULE,registered,[N-1]),
- test_server:format("About to kill pid ~p (~p)\n~p",
- [Pid,process_info(Pid,registered_name),info(Pid)]),
- %%exit(Pid,kill),
- registered(N-1).
-
-info(Pid) ->
- Rest0 = tl(pid_to_list(Pid)),
- {P1,Rest1} = get_until($.,Rest0),
- {P2,Rest2} = get_until($.,Rest1),
- {P3,_} = get_until($>,Rest2),
- c:i(list_to_integer(P1),list_to_integer(P2),list_to_integer(P3)).
-
-get_until(Ch,L) ->
- get_until(Ch,L,[]).
-get_until(Ch,[],Acc) ->
- {lists:reverse(Acc),[]};
-get_until(Ch,[Ch|T],Acc) ->
- {lists:reverse(Acc),T};
-get_until(Ch,[H|T],Acc) ->
- get_until(Ch,T,[H|Acc]).
-
-select_victim(registered) ->
- Pids =
- lists:map(fun(Server)-> whereis(Server) end,registered()),
- ImmunePids =
- [self()|lists:map(fun(Job)-> element(2,Job) end,test_server:jobs())],
- SuitablePids =
- lists:filter(fun(Pid)-> case lists:member(Pid,ImmunePids) of
- true -> false;
- false -> true
- end
- end, Pids),
- Selected = random:uniform(length(SuitablePids)),
- io:format("Selected ~p if ~p",[Selected,length(SuitablePids)]),
- lists:nth(Selected,SuitablePids).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/test_server/src/things/soft.gs.txt b/lib/test_server/src/things/soft.gs.txt
deleted file mode 100644
index ec57884997..0000000000
--- a/lib/test_server/src/things/soft.gs.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-6> gs:start().
-RealTimeViolation, 478ms (after 1164 good)
-{1,<0.65.0>}
-RealTimeViolation, 352ms (after 0 good)
-RealTimeViolation, 492ms (after 0 good)
-RealTimeViolation, 166ms (after 0 good)
-RealTimeInfo, 18ms (after 7 good)
-RealTimeViolation, 115ms (after 13 good)
-7> application-specific initialization failed: couldn't connect to display ":0.0"
-RealTimeViolation, 20340ms (after 0 good)
-gs error: user backend died reason {port_handler,#Port,normal}
-
-RealTimeInfo, 31ms (after 21 good)
-RealTimeInfo, 21ms (after 69 good)
-RealTimeInfo, 21ms (after 119 good)
-RealTimeInfo, 21ms (after 169 good)
diff --git a/lib/test_server/src/things/verify.erl b/lib/test_server/src/things/verify.erl
deleted file mode 100644
index b09d0fbda9..0000000000
--- a/lib/test_server/src/things/verify.erl
+++ /dev/null
@@ -1,200 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(verify).
-
--export([dir/0, dir/1]).
-
-%% usage verify:dir()
-%% or verify:dir(Dir)
-%%
-%% runs tests on all files with the extension ".t1"
-%% creates an error log file verify.log in the directory where the
-%% tests were run
-
--import(lists, [reverse/1, foldl/3, map/2]).
-
-dir() ->
- dir(".").
-
-dir(Dir) ->
- case file:list_dir(Dir) of
- {ok, Files} ->
- VFiles = collect_vers(Files, []),
- VFiles1 = map(fun(F) -> Dir ++ "/" ++ F end, VFiles),
- Nerrs = foldl(fun(F, Sum) ->
- case file(F) of
- {file,_,had,N,errors} ->
- Sum + N;
- no_errors ->
- Sum;
- Other ->
- Sum + 1
- end
- end, 0, VFiles1),
- case Nerrs of
- 0 -> no_errors;
- _ -> {dir,Dir,had,Nerrs,errors}
- end;
- _ ->
- {error, cannot,list_dir, Dir}
- end.
-
-collect_vers([H|T], L) ->
- case reverse(H) of
- [$1,$t,$.|T1] -> collect_vers(T, [reverse(T1)|L]);
- _ -> collect_vers(T, L)
- end;
-collect_vers([], L) ->
- L.
-
-file(File) ->
- case file:open(File ++ ".t1", read) of
- {ok, S} ->
- io:format("Verifying: ~s\n", [File]),
- ErrFile = File ++ ".errs",
- {ok, E} = file:open(ErrFile, write),
- Bind0 = erl_eval:new_bindings(),
- NErrs = do(S, {E, File, Bind0, 0}, 1),
- file:close(S),
- file:close(E),
- case NErrs of
- 0 ->
- file:delete(ErrFile),
- no_errors;
- _ ->
- {file,File,had,NErrs,errors}
- end;
- _ ->
- error_in_opening_file
- end.
-
-do(S, Env, Line) ->
- R = io:scan_erl_exprs(S, '', Line),
- do1(R, S, Env).
-
-do1({eof,_}, _, {_,_,_,NErrs}) ->
- NErrs;
-do1({ok,Toks,Next}, S, Env0) ->
- E1 = handle_toks(Toks, Next, Env0),
- do(S, E1, Next);
-do1({error, {Line,Mod,Args}, Next}, S, E) ->
- io:format("*** ~w ~p~n", [Line,Mod:format_error(Args)]),
- E1 = add_error(E),
- do(S, E1, Next).
-
-add_error({Stream, File, Bindings, N}) -> {Stream, File, Bindings, N+1}.
-
-handle_toks(Toks, Line, Env0) ->
- %% io:format("Toks:~p\n", [Toks]).
- case erl_parse:parse_exprs(Toks) of
- {ok, Exprs} ->
- %% io:format("Got:~p\n", [Exprs]),
- eval(Exprs, Line, Env0);
- {error, {LineNo, Mod, What}} ->
- Str = apply(Mod, format_error, [What]),
- io:format("*** Line:~w ***~s\n", [LineNo, Str]),
- add_error(Env0);
- Parse_error ->
- io:format("Parse Error:~p\n",[Parse_error]),
- add_error(Env0)
- end.
-
-forget([{var,_,Name}], B0) -> erl_eval:del_binding(Name, B0);
-forget([], _) -> erl_eval:new_bindings().
-
-eval([{call,_,{atom,_,f}, Args}], _, {Stream, Bind0, Errs}) ->
- Bind1 = forget(Args, Bind0),
- {Stream, Bind1, Errs};
-eval(Exprs, Line, {Stream, File, Bind0, NErrs}) ->
- %% io:format("Bindings >> ~p\n", [Bind0]),
- %% io:format("Exprs >> ~p\n", [Exprs]),
- case catch erl_eval:exprs(Exprs, Bind0) of
- {'EXIT', Reason} ->
- out_both(Stream, "----------------------------------~n", []),
- out_both(Stream, "File:~s Error in:~s~n", [File, pp(Exprs)]),
- print_bindings(Stream, Exprs, Bind0),
- print_lhs(Stream, Exprs),
- out_both(Stream, '*** Rhs evaluated to:~p~n',[rhs(Exprs, Bind0)]),
- {Stream, File, Bind0, NErrs+1};
- {value, _, Bind1} ->
- {Stream, File, Bind1, NErrs}
- end.
-
-pp([H]) -> erl_pp:expr(H);
-pp([H|T]) -> [erl_pp:expr(H),$,|pp(T)];
-pp([]) -> [].
-
-print_bindings(E, Form, Bindings) ->
- case varsin(Form) of
- [] ->
- true;
- Vars ->
- print_vars(E, Vars, Bindings)
- end.
-
-print_vars(E, [Var|T], Bindings) ->
- case erl_eval:binding(Var, Bindings) of
- {value, Val} ->
- out_both(E, '~s = ~p\n',[Var, Val]);
- unbound ->
- out_both(E, '~s *is unbound*\n', [Var])
- end,
- print_vars(E, T, Bindings);
-print_vars(_, [], _) ->
- true.
-
-
-out_both(E, Format, Data) ->
- io:format(Format, Data),
- io:format(E, Format, Data).
-
-print_lhs(E, [{match, _, Lhs, Rhs}]) ->
- %% io:format(">>>> here:~w\n",[Lhs]),
- out_both(E, '*** Lhs was:~s\n',[erl_pp:expr(Lhs)]);
-print_lhs(E, _) ->
- out_both(E, '** UNDEFINED **', []).
-
-
-rhs([{match, _, Lhs, Rhs}], Bindings) ->
- case catch erl_eval:exprs([Rhs], Bindings) of
- {value, Val, _} -> Val;
- Other -> undefined()
- end;
-rhs(_, _) ->
- undefined().
-
-varsin(X) -> varsin(X, []).
-
-varsin({var,_,'_'}, L) ->
- L;
-varsin({var,_,V}, L) ->
- case lists:member(V, L) of
- true -> L;
- false -> [V|L]
- end;
-varsin([H|T], L) ->
- varsin(T, varsin(H, L));
-varsin(T, L) when tuple(T) ->
- varsin(tuple_to_list(T), L);
-varsin(_, L) ->
- L.
-
-undefined() ->
- '** UNDEFINED **'.
diff --git a/lib/test_server/src/ts.config b/lib/test_server/src/ts.config
deleted file mode 100644
index cf3d269616..0000000000
--- a/lib/test_server/src/ts.config
+++ /dev/null
@@ -1,46 +0,0 @@
-%% -*- erlang -*-
-
-%%% Change these to suite the environment. See the inet_SUITE for info about
-%%% what they are used for.
-%%% test_hosts are looked up using "ypmatch xx yy zz hosts.byname"
-%{test_hosts,[my_ip4_host]}.
-
-%% IPv4 host only - no ipv6 entry must exist!
-%{test_host_ipv4_only,
-% {"my_ip4_host", %Short hostname
-% "my_ip4_host.mydomain.com", %Long hostname
-% "10.10.0.1", %IP string
-% {10,10,0,1}, %IP tuple
-% ["my_ip4_host"], %Any aliases
-% "::ffff:10.10.0.1", %IPv6 string (compatibility addr)
-% {0,0,0,0,0,65535,2570,1} %IPv6 tuple
-% }}.
-
-%{test_dummy_host, {"dummy",
-% "dummy.mydomain.com",
-% "192.168.0.1",
-% {192,168,0,1},
-% ["dummy"],
-% "::ffff:192.168.0.1",
-% {0,0,0,0,0,65535,49320,1}
-% }}.
-
-
-%%% test_hosts are looked up using "ypmatch xx yy zz ipnodes.byname"
-%{ipv6_hosts,[my_ip6_host]}.
-
-
-%{test_host_ipv6_only,
-% {"my_ip6_host", %Short hostname
-% "my_ip6_host.mydomain.com", %Long hostname
-% "::2eff:f2b0:1ea0", %IPv6 string
-% {0,0,0,0,0,12031,62128,7840}, %IPv6 tuple
-% ["my_ip6_host"] %Aliases.
-% }}.
-
-%{test_dummy_ipv6_host, {"dummy6",
-% "dummy6.mydomain.com",
-% "127::1",
-% {295,0,0,0,0,0,0,1},
-% ["dummy6-ip6"]
-% }}.
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
deleted file mode 100644
index 8bbdc8f8cf..0000000000
--- a/lib/test_server/src/ts.erl
+++ /dev/null
@@ -1,1019 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%%-------------------------------------------------------------------
-%%% File : ts.erl
-%%% Purpose : Frontend for running tests.
-%%%-------------------------------------------------------------------
-
--module(ts).
-
--export([cl_run/1,
- run/0, run/1, run/2, run/3, run/4, run/5,
- run_category/1, run_category/2, run_category/3,
- tests/0, tests/1, suites/1, categories/1,
- install/0, install/1,
- estone/0, estone/1,
- cross_cover_analyse/1,
- compile_testcases/0, compile_testcases/1,
- help/0]).
-
-%% Functions kept for backwards compatibility
--export([bench/0, bench/1, bench/2, benchmarks/0,
- smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0]).
-
--export([i/0, l/1, r/0, r/1, r/2, r/3]).
-
-%%%----------------------------------------------------------------------
-%%% This module, ts, is the interface to all of the functionality of
-%%% the TS framework. The picture below shows the relationship of
-%%% the modules:
-%%%
-%%% +-- ts_install --+------ ts_autoconf_win32
-%%% |
-%%% ts ---+ +------ ts_erl_config
-%%% | | ts_lib
-%%% +-- ts_run -----+------ ts_make
-%%% | | ts_filelib
-%%% | +------ ts_make_erl
-%%% |
-%%% +-- ts_benchmark
-%%%
-%%% The modules ts_lib and ts_filelib contains utilities used by
-%%% the other modules.
-%%%
-%%% Module Description
-%%% ------ -----------
-%%% ts Frontend to the test server framework. Contains all
-%%% interface functions.
-%%% ts_install Installs the test suite. On Unix, `autoconf' is
-%%% is used; on Windows, ts_autoconf_win32 is used.
-%%% The result is written to the file `variables'.
-%%% ts_run Supervises running of the tests.
-%%% ts_autconf_win32 An `autoconf' for Windows.
-%%% ts_autconf_cross_env `autoconf' for other platforms (cross environment)
-%%% ts_erl_config Finds out information about the Erlang system,
-%%% for instance the location of erl_interface.
-%%% This works for either an installed OTP or an Erlang
-%%% system running in a git repository/source tree.
-%%% ts_make Interface to run the `make' program on Unix
-%%% and other platforms.
-%%% ts_make_erl A corrected version of the standar Erlang module
-%%% make (used for rebuilding test suites).
-%%% ts_lib Miscellanous utility functions, each used by several
-%%% other modules.
-%%% ts_benchmark Supervises otp benchmarks and collects results.
-%%%----------------------------------------------------------------------
-
--include_lib("kernel/include/file.hrl").
--include("ts.hrl").
-
--define(
- install_help,
- [
- " ts:install()\n",
- " Install ts with no options.\n",
- "\n",
- " ts:install(Options)\n",
- " Install ts with a list of options, see below.\n",
- "\n",
- "Installation options supported:\n\n",
- " {longnames, true} - Use fully qualified hostnames\n",
- " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n"
- " quiet(default).\n"
- " {crossroot, ErlTop}\n"
- " - Erlang root directory on build host, ~n"
- " normally same value as $ERL_TOP\n"
- " {crossenv, [{Key,Val}]}\n"
- " - Environmentals used by test configure on build host\n"
- " {crossflags, FlagsString}\n"
- " - Flags used by test configure on build host\n"
- " {xcomp, XCompFile}\n"
- " - The xcomp file to use for cross compiling the~n"
- " testcases. Using this option will override any~n"
- " cross* configurations given to ts. Note that you~n"
- " have to have a correct ERL_TOP as well.~n"
- ]).
-
-help() ->
- case filelib:is_file(?variables) of
- false -> help(uninstalled);
- true -> help(installed)
- end.
-
-help(uninstalled) ->
- H = ["ts is not yet installed. To install use:\n\n"],
- show_help([H,?install_help]);
-help(installed) ->
- H = ["\n",
- "Run functions:\n\n",
- " ts:run()\n",
- " Run the tests for all apps. The tests are defined by the\n",
- " main test specification for each app: ../App_test/App.spec.\n",
- "\n",
- " ts:run(Apps)\n",
- " Apps = atom() | [atom()]\n",
- " Run the tests for an app, or set of apps. The tests are\n",
- " defined by the main test specification for each app:\n",
- " ../App_test/App.spec.\n",
- "\n",
- " ts:run(App, Suites)\n",
- " App = atom(), Suites = atom() | [atom()]\n",
- " Run one or more test suites for App (i.e. modules named\n",
- " *_SUITE.erl, located in ../App_test/).\n",
- "\n",
- " ts:run(App, Suite, TestCases)\n",
- " App = atom(), Suite = atom(),\n",
- " TestCases = TCs | {testcase,TCs}, TCs = atom() | [atom()]\n",
- " Run one or more test cases (functions) in Suite.\n",
- "\n",
- " ts:run(App, Suite, {group,Groups})\n",
- " App = atom(), Suite = atom(), Groups = atom() | [atom()]\n",
- " Run one or more test case groups in Suite.\n",
- "\n",
- " ts:run(App, Suite, {group,Group}, {testcase,TestCases})\n",
- " App = atom(), Suite = atom(), Group = atom(),\n",
- " TestCases = atom() | [atom()]\n",
- " Run one or more test cases in a test case group in Suite.\n",
- "\n",
- " ts:run_category(TestCategory)\n",
- " TestCategory = smoke | essential | bench | atom()\n",
- " Run the specified category of tests for all apps.\n",
- " For each app, the tests are defined by the specification:\n",
- " ../App_test/App_TestCategory.spec.\n",
- "\n",
- " ts:run_category(Apps, TestCategory)\n",
- " Apps = atom() | [atom()],\n",
- " TestCategory = smoke | essential | bench | atom()\n",
- " Run the specified category of tests for the given app or apps.\n",
- "\n",
- " Note that the test category parameter may have arbitrary value,\n",
- " but should correspond to an existing test specification with file\n",
- " name: ../App_test/App_TestCategory.spec.\n",
- " Predefined categories exist for smoke tests, essential tests and\n",
- " benchmark tests. The corresponding specs are:\n",
- " ../*_test/Spec_smoke.spec, ../*_test/Spec_essential.spec and\n",
- " ../*_test/Spec_bench.spec.\n",
- "\n",
- " All above run functions can take an additional last argument,\n",
- " Options, which is a list of options (e.g. ts:run(App, Options),\n",
- " or ts:run_category(Apps, TestCategory, Options)).\n",
- "\n",
- "Run options supported:\n\n",
- " batch - Do not start a new xterm\n",
- " {verbose, Level} - Same as the verbosity option for install\n",
- " verbose - Same as {verbose, 1}\n",
- " {vars, Vars} - Variables in addition to the 'variables' file\n",
- " Can be any of the install options\n",
- " {trace, TraceSpec}- Start call trace on target and slave nodes\n",
- " TraceSpec is the name of a file containing\n",
- " trace specifications or a list of trace\n",
- " specification elements.\n",
- " {config, Path} - Specify which directory ts should get it's \n"
- " config files from. The files should follow\n"
- " the convention lib/test_server/src/ts*.config.\n"
- " These config files can also be specified by\n"
- " setting the TEST_CONFIG_PATH environment\n"
- " variable to the directory where the config\n"
- " files are. The default location is\n"
- " tests/test_server/.\n"
- "\n",
- "Supported trace information elements:\n\n",
- " {tp | tpl, Mod, [] | match_spec()}\n",
- " {tp | tpl, Mod, Func, [] | match_spec()}\n",
- " {tp | tpl, Mod, Func, Arity, [] | match_spec()}\n",
- " {ctp | ctpl, Mod}\n",
- " {ctp | ctpl, Mod, Func}\n",
- " {ctp | ctpl, Mod, Func, Arity}\n",
- "\n\n",
- "Support functions:\n\n",
- " ts:tests()\n",
- " Returns all apps available for testing.\n",
- "\n",
- " ts:tests(TestCategory)\n",
- " Returns all apps that provide tests in the given category.\n",
- "\n",
- " ts:suites(App)\n",
- " Returns all available test suites for App,\n",
- " i.e. ../App_test/*_SUITE.erl\n",
- "\n",
- " ts:categories(App)\n",
- " Returns all test categories available for App.\n",
- "\n",
- " ts:estone()\n",
- " Runs estone_SUITE in the kernel application with no run options\n",
- "\n",
- " ts:estone(Opts)\n",
- " Runs estone_SUITE in the kernel application with the given\n",
- " run options\n",
- "\n",
- " ts:cross_cover_analyse(Level)\n",
- " Use after ts:run with option cover or cover_details. Analyses\n",
- " modules specified with a 'cross' statement in the cover spec file.\n",
- " Level can be 'overview' or 'details'.\n",
- "\n",
- " ts:compile_testcases()\n",
- " ts:compile_testcases(Apps)\n",
- " Compiles all test cases for the given apps, for usage in a\n",
- " cross compilation environment.\n",
- "\n\n",
- "Installation (already done):\n\n"
- ],
- show_help([H,?install_help]).
-
-show_help(H) ->
- io:format(lists:flatten(H)).
-
-
-%% Installs tests.
-install() ->
- ts_install:install(install_local,[]).
-install(Options) when is_list(Options) ->
- ts_install:install(install_local,Options).
-
-%% run/0
-%% Runs all specs found by ts:tests(), if any, or returns
-%% {error, no_tests_available}. (batch)
-run() ->
- case ts:tests() of
- [] ->
- {error, no_tests_available};
- _ ->
- check_and_run(fun(Vars) -> run_all(Vars) end)
- end.
-run_all(_Vars) ->
- run_some(tests(), [batch]).
-
-run_some([], _Opts) ->
- ok;
-run_some(Apps, Opts) ->
- case proplists:get_value(test_category, Opts) of
- bench ->
- check_and_run(fun(Vars) -> ts_benchmark:run(Apps, Opts, Vars) end);
- _Other ->
- run_some1(Apps, Opts)
- end.
-
-run_some1([], _Opts) ->
- ok;
-run_some1([{App,Mod}|Apps], Opts) ->
- case run(App, Mod, Opts) of
- ok -> ok;
- Error -> io:format("~p: ~p~n",[{App,Mod},Error])
- end,
- run_some1(Apps, Opts);
-run_some1([App|Apps], Opts) ->
- case run(App, Opts) of
- ok -> ok;
- Error -> io:format("~p: ~p~n",[App,Error])
- end,
- run_some1(Apps, Opts).
-
-%% This can be used from command line. Both App and
-%% TestCategory must be specified. App may be 'all'
-%% and TestCategory may be 'main'. Examples:
-%% erl -s ts cl_run kernel smoke <options>
-%% erl -s ts cl_run kernel main <options>
-%% erl -s ts cl_run all essential <options>
-%% erl -s ts cl_run all main <options>
-%% When using the 'main' category and running with cover,
-%% one can also use the cross_cover_analysis flag.
-cl_run([App,Cat|Options0]) when is_atom(App) ->
-
- AllAtomsFun = fun(X) when is_atom(X) -> true;
- (_) -> false
- end,
- Options1 =
- case lists:all(AllAtomsFun, Options0) of
- true ->
- %% Could be from command line
- lists:map(fun(Opt) ->
- to_erlang_term(Opt)
- end, Options0) -- [batch];
- false ->
- Options0 -- [batch]
- end,
- %% Make sure there is exactly one occurence of 'batch'
- Options2 = [batch|Options1],
-
- Result =
- case {App,Cat} of
- {all,main} ->
- run(tests(), Options2);
- {all,Cat} ->
- run_category(Cat, Options2);
- {_,main} ->
- run(App, Options2);
- {_,Cat} ->
- run_category(App, Cat, Options2)
- end,
- case check_for_cross_cover_analysis_flag(Options2) of
- false ->
- ok;
- Level ->
- cross_cover_analyse(Level)
- end,
- Result.
-
-%% run/1
-%% Runs tests for one app (interactive).
-run(App) when is_atom(App) ->
- Options = check_test_get_opts(App, []),
- File = atom_to_list(App),
- run_test(File, [{spec,[File++".spec"]},{allow_user_terms,true}], Options);
-
-%% This can be used from command line, e.g.
-%% erl -s ts run all <options>
-%% erl -s ts run main <options>
-run([all,main|Opts]) ->
- cl_run([all,main|Opts]);
-run([all|Opts]) ->
- cl_run([all,main|Opts]);
-run([main|Opts]) ->
- cl_run([all,main|Opts]);
-%% Backwards compatible
-run([all_tests|Opts]) ->
- cl_run([all,main|Opts]);
-
-%% run/1
-%% Runs the main tests for all available apps
-run(Apps) when is_list(Apps) ->
- run(Apps, [batch]).
-
-%% run/2
-%% Runs the main tests for all available apps
-run(Apps, Opts) when is_list(Apps), is_list(Opts) ->
- run_some(Apps, Opts);
-
-%% Runs tests for one app with list of suites or with options
-run(App, ModsOrOpts) when is_atom(App),
- is_list(ModsOrOpts) ->
- case is_list_of_suites(ModsOrOpts) of
- false ->
- run(App, {opts_list,ModsOrOpts});
- true ->
- run_some([{App,M} || M <- ModsOrOpts],
- [batch])
- end;
-
-run(App, {opts_list,Opts}) ->
- Options = check_test_get_opts(App, Opts),
- File = atom_to_list(App),
-
- %% check if other test category than main has been specified
- {CatSpecName,TestCat} =
- case proplists:get_value(test_category, Opts) of
- undefined ->
- {"",main};
- Cat ->
- {"_" ++ atom_to_list(Cat),Cat}
- end,
-
- WhatToDo =
- case App of
- %% Known to exist but fails generic tests below
- emulator -> test;
- system -> test;
- erl_interface -> test;
- epmd -> test;
- _ ->
- case code:lib_dir(App) of
- {error,bad_name} ->
- %% Application does not exist
- skip;
- Path ->
- case file:read_file_info(filename:join(Path,"ebin")) of
- {ok,#file_info{type=directory}} ->
- %% Erlang application is built
- test;
- _ ->
- case filelib:wildcard(
- filename:join([Path,"priv","*.jar"])) of
- [] ->
- %% The application is not built
- skip;
- [_|_] ->
- %% Java application is built
- test
- end
- end
- end
- end,
- case WhatToDo of
- skip ->
- SkipSpec = create_skip_spec(App, suites(App)),
- run_test(File, [{spec,[SkipSpec]}], Options);
- test when TestCat == bench ->
- check_and_run(fun(Vars) ->
- ts_benchmark:run([App], Options, Vars)
- end);
- test ->
- Spec = File ++ CatSpecName ++ ".spec",
- run_test(File, [{spec,[Spec]},{allow_user_terms,true}], Options)
- end;
-
-%% Runs one module for an app (interactive)
-run(App, Mod) when is_atom(App), is_atom(Mod) ->
- run_test({atom_to_list(App),Mod},
- [{suite,Mod}],
- [interactive]).
-
-%% run/3
-%% Run one module for an app with Opts
-run(App, Mod, Opts) when is_atom(App),
- is_atom(Mod),
- is_list(Opts) ->
- Options = check_test_get_opts(App, Opts),
- run_test({atom_to_list(App),Mod},
- [{suite,Mod}], Options);
-
-%% Run multiple modules with Opts
-run(App, Mods, Opts) when is_atom(App),
- is_list(Mods),
- is_list(Opts) ->
- run_some([{App,M} || M <- Mods], Opts);
-
-%% Runs one test case in a module.
-run(App, Mod, Case) when is_atom(App),
- is_atom(Mod),
- is_atom(Case) ->
- Options = check_test_get_opts(App, []),
- Args = [{suite,Mod},{testcase,Case}],
- run_test(atom_to_list(App), Args, Options);
-
-%% Runs one or more groups in a module.
-run(App, Mod, Grs={group,_Groups}) when is_atom(App),
- is_atom(Mod) ->
- Options = check_test_get_opts(App, []),
- Args = [{suite,Mod},Grs],
- run_test(atom_to_list(App), Args, Options);
-
-%% Runs one or more test cases in a module.
-run(App, Mod, TCs={testcase,_Cases}) when is_atom(App),
- is_atom(Mod) ->
- Options = check_test_get_opts(App, []),
- Args = [{suite,Mod},TCs],
- run_test(atom_to_list(App), Args, Options).
-
-%% run/4
-%% Run one test case in a module with Options.
-run(App, Mod, Case, Opts) when is_atom(App),
- is_atom(Mod),
- is_atom(Case),
- is_list(Opts) ->
- Options = check_test_get_opts(App, Opts),
- Args = [{suite,Mod},{testcase,Case}],
- run_test(atom_to_list(App), Args, Options);
-
-%% Run one or more test cases in a module with Options.
-run(App, Mod, {testcase,Cases}, Opts) when is_atom(App),
- is_atom(Mod) ->
- run(App, Mod, Cases, Opts);
-run(App, Mod, Cases, Opts) when is_atom(App),
- is_atom(Mod),
- is_list(Cases),
- is_list(Opts) ->
- Options = check_test_get_opts(App, Opts),
- Args = [{suite,Mod},Cases],
- run_test(atom_to_list(App), Args, Options);
-
-%% Run one or more test cases in a group.
-run(App, Mod, Gr={group,_Group}, {testcase,Cases}) when is_atom(App),
- is_atom(Mod) ->
- run(App, Mod, Gr, Cases, [batch]);
-
-
-%% Run one or more groups in a module with Options.
-run(App, Mod, Grs={group,_Groups}, Opts) when is_atom(App),
- is_atom(Mod),
- is_list(Opts) ->
- Options = check_test_get_opts(App, Opts),
- Args = [{suite,Mod},Grs],
- run_test(atom_to_list(App), Args, Options).
-
-%% run/5
-%% Run one or more test cases in a group with Options.
-run(App, Mod, Group, Cases, Opts) when is_atom(App),
- is_atom(Mod),
- is_list(Opts) ->
- Group1 = if is_tuple(Group) -> Group; true -> {group,Group} end,
- Cases1 = if is_tuple(Cases) -> Cases; true -> {testcase,Cases} end,
- Options = check_test_get_opts(App, Opts),
- Args = [{suite,Mod},Group1,Cases1],
- run_test(atom_to_list(App), Args, Options).
-
-%% run_category/1
-run_category(TestCategory) when is_atom(TestCategory) ->
- run_category(TestCategory, [batch]).
-
-%% run_category/2
-run_category(TestCategory, Opts) when is_atom(TestCategory),
- is_list(Opts) ->
- case ts:tests(TestCategory) of
- [] ->
- {error, no_tests_available};
- Apps ->
- Opts1 = [{test_category,TestCategory} | Opts],
- run_some(Apps, Opts1)
- end;
-
-run_category(Apps, TestCategory) when is_atom(TestCategory) ->
- run_category(Apps, TestCategory, [batch]).
-
-%% run_category/3
-run_category(App, TestCategory, Opts) ->
- Apps = if is_atom(App) -> [App];
- is_list(App) -> App
- end,
- Opts1 = [{test_category,TestCategory} | Opts],
- run_some(Apps, Opts1).
-
-%%-----------------------------------------------------------------
-%% Functions kept for backwards compatibility
-
-bench() ->
- run_category(bench, []).
-bench(Opts) when is_list(Opts) ->
- run_category(bench, Opts);
-bench(App) ->
- run_category(App, bench, []).
-bench(App, Opts) when is_atom(App) ->
- run_category(App, bench, Opts);
-bench(Apps, Opts) when is_list(Apps) ->
- run_category(Apps, bench, Opts).
-
-benchmarks() ->
- tests(bench).
-
-smoke_test() ->
- run_category(smoke, []).
-smoke_test(Opts) when is_list(Opts) ->
- run_category(smoke, Opts);
-smoke_test(App) ->
- run_category(App, smoke, []).
-smoke_test(App, Opts) when is_atom(App) ->
- run_category(App, smoke, Opts);
-smoke_test(Apps, Opts) when is_list(Apps) ->
- run_category(Apps, smoke, Opts).
-
-smoke_tests() ->
- tests(smoke).
-
-%%-----------------------------------------------------------------
-
-is_list_of_suites(List) ->
- lists:all(fun(Suite) ->
- S = if is_atom(Suite) -> atom_to_list(Suite);
- true -> Suite
- end,
- try lists:last(string:tokens(S,"_")) of
- "SUITE" -> true;
- "suite" -> true;
- _ -> false
- catch
- _:_ -> false
- end
- end, List).
-
-%% Create a spec to skip all SUITES, this is used when the application
-%% to be tested is not part of the OTP release to be tested.
-create_skip_spec(App, SuitesToSkip) ->
- {ok,Cwd} = file:get_cwd(),
- AppString = atom_to_list(App),
- Specname = AppString++"_skip.spec",
- {ok,D} = file:open(filename:join([filename:dirname(Cwd),
- AppString++"_test",Specname]),
- [write]),
- TestDir = "\"../"++AppString++"_test\"",
- io:format(D,"{suites, "++TestDir++", all}.~n",[]),
- io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application"
- " is not in path!\"}.",[SuitesToSkip]),
- Specname.
-
-%% Check testspec for App to be valid and get possible options
-%% from the list.
-check_test_get_opts(App, Opts) ->
- validate_test(App),
- Mode = configmember(batch, {batch, interactive}, Opts),
- Vars = configvars(Opts),
- Trace = get_config(trace,Opts),
- ConfigPath = get_config(config,Opts),
- KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Opts),
- Cover = configcover(App,Opts),
- lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]).
-
-to_erlang_term(Atom) ->
- String = atom_to_list(Atom),
- {ok, Tokens, _} = erl_scan:string(lists:append([String, ". "])),
- {ok, Term} = erl_parse:parse_term(Tokens),
- Term.
-
-%% Validate that Testspec really is a testspec,
-%% and exit if not.
-validate_test(Testspec) ->
- case lists:member(Testspec, tests()) of
- true ->
- ok;
- false ->
- io:format("This testspec does not seem to be "
- "available.~n Please try ts:tests() "
- "to see available tests.~n"),
- exit(self(), {error, test_not_available})
- end.
-
-configvars(Opts) ->
- case lists:keysearch(vars, 1, Opts) of
- {value, {vars, List}} ->
- List0 = special_vars(Opts),
- Key = fun(T) -> element(1,T) end,
- DelDupList =
- lists:filter(fun(V) ->
- case lists:keysearch(Key(V),1,List0) of
- {value,_} -> false;
- _ -> true
- end
- end, List),
- {vars, [List0|DelDupList]};
- _ ->
- {vars, special_vars(Opts)}
- end.
-
-%% Allow some shortcuts in the options...
-special_vars(Opts) ->
- SpecVars =
- case lists:member(verbose, Opts) of
- true ->
- [{verbose, 1}];
- false ->
- case lists:keysearch(verbose, 1, Opts) of
- {value, {verbose, Lvl}} ->
- [{verbose, Lvl}];
- _ ->
- [{verbose, 0}]
- end
- end,
- SpecVars1 =
- case lists:keysearch(diskless, 1, Opts) of
- {value,{diskless, true}} ->
- [{diskless, true} | SpecVars];
- _ ->
- SpecVars
- end,
- case lists:keysearch(testcase_callback, 1, Opts) of
- {value,{testcase_callback, CBM, CBF}} ->
- [{ts_testcase_callback, {CBM,CBF}} | SpecVars1];
- {value,{testcase_callback, CB}} ->
- [{ts_testcase_callback, CB} | SpecVars1];
- _ ->
- SpecVars1
- end.
-
-get_config(Key,Config) ->
- case lists:keysearch(Key,1,Config) of
- {value,Value} -> Value;
- false -> []
- end.
-
-configcover(Testspec,[cover|_]) ->
- {cover,Testspec,default_coverfile(Testspec),overview};
-configcover(Testspec,[cover_details|_]) ->
- {cover,Testspec,default_coverfile(Testspec),details};
-configcover(Testspec,[{cover,File}|_]) ->
- {cover,Testspec,File,overview};
-configcover(Testspec,[{cover_details,File}|_]) ->
- {cover,Testspec,File,details};
-configcover(Testspec,[_H|T]) ->
- configcover(Testspec,T);
-configcover(_Testspec,[]) ->
- [].
-
-default_coverfile(Testspec) ->
- {ok,Cwd} = file:get_cwd(),
- CoverFile = filename:join([filename:dirname(Cwd),
- atom_to_list(Testspec)++"_test",
- atom_to_list(Testspec)++".cover"]),
- case filelib:is_file(CoverFile) of
- true ->
- CoverFile;
- false ->
- none
- end.
-
-configmember(Member, {True, False}, Config) ->
- case lists:member(Member, Config) of
- true ->
- True;
- false ->
- False
- end.
-
-
-check_for_cross_cover_analysis_flag(Config) ->
- check_for_cross_cover_analysis_flag(Config,false,false).
-check_for_cross_cover_analysis_flag([cover|Config],false,false) ->
- check_for_cross_cover_analysis_flag(Config,overview,false);
-check_for_cross_cover_analysis_flag([cover|_Config],false,true) ->
- overview;
-check_for_cross_cover_analysis_flag([cover_details|Config],false,false) ->
- check_for_cross_cover_analysis_flag(Config,details,false);
-check_for_cross_cover_analysis_flag([cover_details|_Config],false,true) ->
- details;
-check_for_cross_cover_analysis_flag([cross_cover_analysis|Config],false,_) ->
- check_for_cross_cover_analysis_flag(Config,false,true);
-check_for_cross_cover_analysis_flag([cross_cover_analysis|_Config],Level,_) ->
- Level;
-check_for_cross_cover_analysis_flag([_|Config],Level,CrossFlag) ->
- check_for_cross_cover_analysis_flag(Config,Level,CrossFlag);
-check_for_cross_cover_analysis_flag([],_,_) ->
- false.
-
-
-%% Returns all available apps.
-tests() ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:specs(Cwd).
-
-%% Returns all apps that provide tests in the given test category
-tests(main) ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:specs(Cwd);
-tests(bench) ->
- ts_benchmark:benchmarks();
-tests(TestCategory) ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:specialized_specs(Cwd, atom_to_list(TestCategory)).
-
-%% Returns a list of available test suites for App.
-suites(App) ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:suites(Cwd, atom_to_list(App)).
-
-%% Returns all available test categories for App
-categories(App) ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:test_categories(Cwd, atom_to_list(App)).
-
-%%
-%% estone/0, estone/1
-%% Opts = same as Opts or Config for the run(...) function,
-%% e.g. [batch]
-%%
-estone() -> run(emulator,estone_SUITE).
-estone(Opts) when is_list(Opts) -> run(emulator,estone_SUITE,Opts).
-
-%%
-%% cross_cover_analyse/1
-%% Level = details | overview
-%% Can be called on any node after a test (with cover) is
-%% completed. The node's current directory must be the same as when
-%% the tests were run.
-%%
-cross_cover_analyse([Level]) ->
- cross_cover_analyse(Level);
-cross_cover_analyse(Level) ->
- Apps = get_last_app_tests(),
- test_server_ctrl:cross_cover_analyse(Level,Apps).
-
-get_last_app_tests() ->
- AllTests = filelib:wildcard(filename:join(["*","*_test.logs"])),
- {ok,RE} = re:compile("^[^/]*/[^\.]*\.(.*)_test\.logs$"),
- get_last_app_tests(AllTests,RE,[]).
-
-get_last_app_tests([Dir|Dirs],RE,Acc) ->
- NewAcc =
- case re:run(Dir,RE,[{capture,all,list}]) of
- {match,[Dir,AppStr]} ->
- Dir1 = filename:dirname(Dir), % cover logs in ct_run.<t> dir
- App = list_to_atom(AppStr),
- case lists:keytake(App,1,Acc) of
- {value,{App,LastDir},Rest} ->
- if Dir1 > LastDir ->
- [{App,Dir1}|Rest];
- true ->
- Acc
- end;
- false ->
- [{App,Dir1} | Acc]
- end;
- _ ->
- Acc
- end,
- get_last_app_tests(Dirs,RE,NewAcc);
-get_last_app_tests([],_,Acc) ->
- Acc.
-
-%%% Implementation.
-
-check_and_run(Fun) ->
- case file:consult(?variables) of
- {ok, Vars} ->
- check_and_run(Fun, Vars);
- {error, Error} when is_atom(Error) ->
- {error, not_installed};
- {error, Reason} ->
- {error, {bad_installation, file:format_error(Reason)}}
- end.
-
-check_and_run(Fun, Vars) ->
- Platform = ts_install:platform_id(Vars),
- case lists:keysearch(platform_id, 1, Vars) of
- {value, {_, Platform}} ->
- case catch apply(Fun, [Vars]) of
- {'EXIT', Reason} ->
- exit(Reason);
- Other ->
- Other
- end;
- {value, {_, OriginalPlatform}} ->
- io:format("These test suites were installed for '~s'.\n",
- [OriginalPlatform]),
- io:format("But the current platform is '~s'.\nPlease "
- "install for this platform before running "
- "any tests.\n", [Platform]),
- {error, inconsistent_platforms};
- false ->
- {error, {bad_installation, no_platform}}
- end.
-
-run_test(File, Args, Options) ->
- check_and_run(fun(Vars) -> run_test(File, Args, Options, Vars) end).
-
-run_test(File, Args, Options, Vars) ->
- ts_run:run(File, Args, Options, Vars).
-
-
-%% This module provides some convenient shortcuts to running
-%% the test server from within a started Erlang shell.
-%% (This are here for backwards compatibility.)
-%%
-%% r()
-%% r(Opts)
-%% r(SpecOrMod)
-%% r(SpecOrMod, Opts)
-%% r(Mod, Case)
-%% r(Mod, Case, Opts)
-%% Each of these functions starts the test server if it
-%% isn't already running, then runs the test case(s) selected
-%% by the aguments.
-%% SpecOrMod can be a module name or the name of a test spec file,
-%% with the extension .spec or .spec.OsType. The module Mod will
-%% be reloaded before running the test cases.
-%% Opts = [Opt],
-%% Opt = {Cover,AppOrCoverFile} | {Cover,App,CoverFile}
-%% Cover = cover | cover_details
-%% AppOrCoverFile = App | CoverFile
-%% App = atom(), an application name
-%% CoverFile = string(), name of a cover file
-%% (see doc of test_server_ctrl:cover/2/3)
-%%
-%% i()
-%% Shows information about the jobs being run, by dumping
-%% the process information for the test_server.
-%%
-%% l(Mod)
-%% This function reloads a module just like c:l/1, but works
-%% even for a module in one of the sticky library directories
-%% (for instance, lists can be reloaded).
-
-%% Runs all tests cases in the current directory.
-
-r() ->
- r([]).
-r(Opts) when is_list(Opts), is_atom(hd(Opts)) ->
- ensure_ts_started(Opts),
- test_server_ctrl:add_dir("current_dir", ".");
-
-%% Checks if argument is a spec file or a module
-%% (spec file must be named "*.spec" or "*.spec.OsType")
-%% If module, reloads module and runs all test cases in it.
-%% If spec, runs all test cases in it.
-
-r(SpecOrMod) ->
- r(SpecOrMod,[]).
-r(SpecOrMod,Opts) when is_list(Opts) ->
- ensure_ts_started(Opts),
- case filename:extension(SpecOrMod) of
- [] ->
- l(SpecOrMod),
- test_server_ctrl:add_module(SpecOrMod);
- ".spec" ->
- test_server_ctrl:add_spec(SpecOrMod);
- _ ->
- Spec2 = filename:rootname(SpecOrMod),
- case filename:extension(Spec2) of
- ".spec" ->
- %% *.spec.Type
- test_server_ctrl:add_spec(SpecOrMod);
- _ ->
- {error, unknown_filetype}
- end
- end;
-
-%% Reloads the given module and runs the given test case in it.
-
-r(Mod, Case) ->
- r(Mod,Case,[]).
-r(Mod, Case, Opts) ->
- ensure_ts_started(Opts),
- l(Mod),
- test_server_ctrl:add_case(Mod, Case).
-
-%% Shows information about the jobs being run.
-
-i() ->
- ensure_ts_started([]),
- hformat("Job", "Current", "Total", "Success", "Failed", "Skipped"),
- i(test_server_ctrl:jobs()).
-
-i([{Name, Pid}|Rest]) when is_pid(Pid) ->
- {dictionary, PI} = process_info(Pid, dictionary),
- {value, {_, CaseNum}} = lists:keysearch(test_server_case_num, 1, PI),
- {value, {_, Cases}} = lists:keysearch(test_server_cases, 1, PI),
- {value, {_, Failed}} = lists:keysearch(test_server_failed, 1, PI),
- {value, {_, {UserSkipped,AutoSkipped}}} = lists:keysearch(test_server_skipped, 1, PI),
- {value, {_, Ok}} = lists:keysearch(test_server_ok, 1, PI),
- nformat(Name, CaseNum, Cases, Ok, Failed, UserSkipped+AutoSkipped),
- i(Rest);
-i([]) ->
- ok.
-
-hformat(A1, A2, A3, A4, A5, A6) ->
- io:format("~-20s ~8s ~8s ~8s ~8s ~8s~n", [A1,A2,A3,A4,A5,A6]).
-
-nformat(A1, A2, A3, A4, A5, A6) ->
- io:format("~-20s ~8w ~8w ~8w ~8w ~8w~n", [A1,A2,A3,A4,A5,A6]).
-
-%% Force load of a module even if it is in a sticky directory.
-
-l(Mod) ->
- case do_load(Mod) of
- {error, sticky_directory} ->
- Dir = filename:dirname(code:which(Mod)),
- code:unstick_dir(Dir),
- do_load(Mod),
- code:stick_dir(Dir);
- X ->
- X
- end.
-
-
-ensure_ts_started(Opts) ->
- Pid = case whereis(test_server_ctrl) of
- undefined ->
- test_server_ctrl:start();
- P when is_pid(P) ->
- P
- end,
- case Opts of
- [{Cover,AppOrCoverFile}] when Cover==cover; Cover==cover_details ->
- test_server_ctrl:cover(AppOrCoverFile,cover_type(Cover));
- [{Cover,App,CoverFile}] when Cover==cover; Cover==cover_details ->
- test_server_ctrl:cover(App,CoverFile,cover_type(Cover));
- _ ->
- ok
- end,
- Pid.
-
-cover_type(cover) -> overview;
-cover_type(cover_details) -> details.
-
-do_load(Mod) ->
- code:purge(Mod),
- code:load_file(Mod).
-
-
-compile_testcases() ->
- compile_datadirs("../*/*_data").
-
-compile_testcases(App) when is_atom(App) ->
- compile_testcases([App]);
-compile_testcases([App | T]) ->
- compile_datadirs(io_lib:format("../~s_test/*_data", [App])),
- compile_testcases(T);
-compile_testcases([]) ->
- ok.
-
-compile_datadirs(DataDirs) ->
- {ok,Variables} = file:consult("variables"),
-
- lists:foreach(fun(Dir) ->
- ts_lib:make_non_erlang(Dir, Variables)
- end,
- filelib:wildcard(DataDirs)).
diff --git a/lib/test_server/src/ts.hrl b/lib/test_server/src/ts.hrl
deleted file mode 100644
index 4c940fdc4f..0000000000
--- a/lib/test_server/src/ts.hrl
+++ /dev/null
@@ -1,38 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%% Defines ripped out from test_server (these must remain the same
-%% as in test_server).
-
--define(logdir_ext, ".logs").
--define(suitelog_name, "suite.log").
--define(last_file, "last_name").
--define(last_link, "last_link").
--define(last_test, "last_test").
--define(run_summary, "suite.summary").
--define(cover_total,"total_cover.log").
--define(variables, "variables").
--define(cross_variables, "variables-cross").
--define(LF, [10]). % Newline in VxWorks script
--define(CHAR_PER_LINE, 60). % Characters per VxWorks script building line
--define(CROSS_COOKIE, "cross"). % cookie used when cross platform testing
--define(TS_PORT, 7887).
--define(TEST_SERVER_SCRIPT, "test_server_vx.script").
-
diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config
deleted file mode 100644
index 1ba5d9033e..0000000000
--- a/lib/test_server/src/ts.unix.config
+++ /dev/null
@@ -1,6 +0,0 @@
-%% -*- erlang -*-
-
-%% Always run a (VNC) X server on host
-%% {xserver, "xserver.example.com:66"}.
-
-{unix,[{telnet,"belegost"},{username,"telnet-test"},{password,"tset-tenlet"},{keep_alive,true}]}.
diff --git a/lib/test_server/src/ts.win32.config b/lib/test_server/src/ts.win32.config
deleted file mode 100644
index cae587bea8..0000000000
--- a/lib/test_server/src/ts.win32.config
+++ /dev/null
@@ -1,8 +0,0 @@
-%% -*- erlang -*-
-
-%%% There is no equivalent command to ypmatch on Win32... :-(
-%{hardcoded_hosts,
-% [{"127.0.0.1","localhost"}]}.
-
-%{hardcoded_ipv6_hosts,
-% [{"::1","localhost"}]}.
diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/test_server/src/ts_autoconf_win32.erl
deleted file mode 100644
index 288305b406..0000000000
--- a/lib/test_server/src/ts_autoconf_win32.erl
+++ /dev/null
@@ -1,256 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% Purpose : Autoconf for Windows.
-
--module(ts_autoconf_win32).
--export([configure/0]).
-
--include("ts.hrl").
-
-configure() ->
- case variables() of
- {ok, Vars} ->
- ts_lib:subst_file("conf_vars.in", "conf_vars", Vars);
- Error ->
- Error
- end.
-
-variables() ->
- run_tests(tests(), []).
-
-run_tests([{Prompt, Tester}|Rest], Vars) ->
- io:format("checking ~s... ", [Prompt]),
- case catch Tester(Vars) of
- {'EXIT', Reason} ->
- io:format("FAILED~nExit status: ~p~n", [Reason]),
- {error, auto_conf_failed};
- {Result, NewVars} ->
- io:format("~s~n", [lists:concat([Result])]),
- run_tests(Rest, NewVars)
- end;
-run_tests([], Vars) ->
- {ok, Vars}.
-
-%%% The tests.
-
-tests() ->
- [{"host system type", fun system_type/1},
- {"CPU type", fun cpu/1},
- {"for C compiler", fun c_compiler/1},
- {"for make program", fun make/1},
- {"for location of SSL libraries", fun ssl/1},
- {"for location of Java compiler", fun javac/1}].
-
-system_type(Vars) ->
- Os = case os:type() of
- {win32, nt} ->
- case os:version() of
- {4,_,_} -> "Windows NT";
- {5,0,_} -> "Windows 2000";
- {5,1,_} -> "Windows XP";
- {5,2,_} -> "Windows 2003";
- {6,0,_} -> "Windows Vista";
- {6,1,_} -> "Windows 7";
- {_,_,_} -> "Windows NCC-1701-D"
- end;
- {win32, windows} ->
- case os:version() of
- {4,0,_} -> "Windows 95";
- {4,10,_} -> "Windows 98"
- end;
- {win32, _} -> "Windows"
- end,
- {Os, [{host_os, Os}, {host, "win32"}|Vars]}.
-
-cpu(Vars) ->
- Arch = os:getenv("PROCESSOR_ARCHITECTURE"),
- Level0 = os:getenv("PROCESSOR_Level"),
- Cpu = case {Arch, Level0} of
- {"x86", Level} when is_list(Level) ->
- "i" ++ Level ++ "86";
- {Other, _Level} when is_list(Other) ->
- Other;
- {false, _} ->
- "i386"
- end,
- {Cpu, [{host_cpu, Cpu}|Vars]}.
-
-c_compiler(Vars) ->
- try
- CompTests = [{msc, fun visual_cxx/1},
- {gnuc, fun mingw32/1}],
- %% First try to find the same compiler that the system
- %% was built with...
- UsedCompiler = case erlang:system_info(c_compiler_used) of
- {UsedCmplr, _} ->
- case lists:keysearch(UsedCmplr, 1, CompTests) of
- {value, {UsedCmplr, CompTest}} ->
- CompTest(Vars);
- _ ->
- ok
- end,
- UsedCmplr;
- undefined ->
- undefined
- end,
- %% ... then try to find a compiler...
- lists:foreach(fun ({Cmplr, _CmplrTst}) when Cmplr =:= UsedCompiler ->
- ok; % Have already checked for this one
- ({_Cmplr, CmplrTst}) ->
- CmplrTst(Vars)
- end,
- CompTests),
- {no, Vars}
- catch
- throw:{_Path, _NewVars} = Res -> Res
- end.
-
-visual_cxx(Vars) ->
- case os:find_executable("cl") of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- {DEFAULT_THR_LIB,
- ERTS_THR_LIB,
- DLL,
- DBG_LINK,
- DBG_COMP,
- OPT} =
- case is_debug_build() of
- true ->
- {"-MTd ",
- "-MDd ",
- "-LDd ",
- "-debug -pdb:none ",
- "-Z7 -DDEBUG",
- " "};
- false ->
- {"-MT ",
- "-MD ",
- "-LD ",
- " ",
- " ",
- "-Ox "}
- end,
- WIN32 = "-D__WIN32__ ",
- ERTS_CFLAGS = ERTS_THR_LIB ++ WIN32 ++ OPT ++ DBG_COMP,
- LIBS = "ws2_32.lib",
- CC = "cl -nologo",
- throw({Path, [{'CC', CC},
- {'LD', CC},
- {'SHLIB_LD', CC},
- {'SHLIB_LDFLAGS', ERTS_THR_LIB ++ DLL},
- {'SHLIB_LDLIBS', "-link " ++ DBG_LINK ++ "kernel32.lib"},
- {'SHLIB_EXTRACT_ALL', ""},
- {'CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP},
- {'EI_CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP},
- {'ERTS_CFLAGS', ERTS_CFLAGS},
- {'SHLIB_CFLAGS', ERTS_CFLAGS++DLL},
- {'CROSSLDFLAGS', ""},
- {'DEFS', common_c_defs()},
- {'SHLIB_SUFFIX', ".dll"},
- {'ERTS_LIBS', ERTS_THR_LIB ++ LIBS},
- {'LIBS', DEFAULT_THR_LIB ++ "-link " ++ DBG_LINK ++ LIBS},
- {obj,".obj"},
- {exe, ".exe"},
- {test_c_compiler, "{msc, undefined}"}
- | Vars]})
- end.
-
-mingw32(Vars) ->
- Gcc = "mingw32-gcc",
- case os:find_executable(Gcc) of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- {DBG_COMP,
- OPT} =
- case is_debug_build() of
- true ->
- {"-DDEBUG",
- " "};
- false ->
- {" ",
- "-O2 "}
- end,
- WIN32 = "-D__WIN32__ ",
- ERTS_CFLAGS = WIN32 ++ "-g " ++ OPT ++ DBG_COMP,
- LIBS = "-lws2_32",
- CC = Gcc,
- throw({Path, [{'CC', CC},
- {'LD', CC},
- {'SHLIB_LD', CC},
- {'SHLIB_LDFLAGS', "-shared "},
- {'SHLIB_LDLIBS', " -lkernel32"},
- {'SHLIB_EXTRACT_ALL', ""},
- {'CFLAGS', WIN32 ++ DBG_COMP},
- {'EI_CFLAGS', WIN32 ++ DBG_COMP},
- {'ERTS_CFLAGS', ERTS_CFLAGS},
- {'SHLIB_CFLAGS', ERTS_CFLAGS},
- {'CROSSLDFLAGS', ""},
- {'DEFS', common_c_defs()},
- {'SHLIB_SUFFIX', ".dll"},
- {'ERTS_LIBS', LIBS},
- {'LIBS', LIBS},
- {obj,".o"},
- {exe, ".exe"},
- {test_c_compiler, "{gnuc, undefined}"}
- | Vars]})
- end.
-
-common_c_defs() ->
- "-DHAVE_STRERROR=1".
-
-make(Vars) ->
- try
- find_make("nmake -nologo", Vars),
- find_make("mingw32-make", Vars)
- catch
- throw:{_Path, _NewVars} = Res -> Res
- end.
-
-find_make(MakeCmd, Vars) ->
- [Make|_] = string:tokens(MakeCmd, " \t"),
- case os:find_executable(Make) of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- throw({Path, [{make_command, MakeCmd} | Vars]})
- end.
-
-ssl(Vars) ->
- {"win32",[{'SSLEAY_ROOT',"win32"}|Vars]}.
-
-javac(Vars) ->
- case os:find_executable("javac") of
- false ->
- {no, Vars};
- Path when is_list(Path) ->
- {Path, [{'JAVAC', "javac"} | Vars]}
- end.
-
-is_debug_build() ->
- case catch string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 ->
- true;
- _ ->
- false
- end.
diff --git a/lib/test_server/src/ts_benchmark.erl b/lib/test_server/src/ts_benchmark.erl
deleted file mode 100644
index 3e55edefb0..0000000000
--- a/lib/test_server/src/ts_benchmark.erl
+++ /dev/null
@@ -1,87 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2012-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ts_benchmark).
-
--include_lib("common_test/include/ct_event.hrl").
--include_lib("kernel/include/file.hrl").
--include("ts.hrl").
-
--export([benchmarks/0,
- run/3]).
-
-%% gen_event callbacks
--export([init/1, handle_event/2]).
-
-benchmarks() ->
- {ok, Cwd} = file:get_cwd(),
- ts_lib:specialized_specs(Cwd,"bench").
-
-run(Specs, Opts, Vars) ->
- {ok, Cwd} = file:get_cwd(),
- {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(),
- BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]),
- BDir = filename:join([Cwd,BName]),
- file:make_dir(BDir),
- [ts_run:run(atom_to_list(Spec),
- [{spec, [atom_to_list(Spec)++"_bench.spec"]}],
- [{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars)
- || Spec <- Specs],
- file:delete(filename:join(Cwd,"latest_benchmark")),
- {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]),
- io:format(D,BDir,[]),
- file:close(D).
-
-
-%%%===================================================================
-%%% gen_event callbacks
-%%%===================================================================
-
--record(state, { spec, suite, tc, stats_dir}).
-
-init([Spec,Dir]) ->
- {ok, #state{ spec = Spec, stats_dir = Dir }}.
-
-handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) ->
- {ok,State#state{ suite = Suite, tc = Tc}};
-handle_event(#event{name = benchmark_data, data = Data}, State) ->
- Spec = proplists:get_value(application, Data, State#state.spec),
- Suite = proplists:get_value(suite, Data, State#state.suite),
- Tc = proplists:get_value(name, Data, State#state.tc),
- Value = proplists:get_value(value, Data),
- {ok, D} = file:open(filename:join(
- [State#state.stats_dir,
- lists:concat([e(Spec),"-",e(Suite),"-",
- e(Tc),".ebench"])]),
- [append]),
- io:format(D, "~p~n",[Value]),
- file:close(D),
- {ok, State};
-handle_event(_Event, State) ->
- {ok, State}.
-
-
-e(Atom) when is_atom(Atom) ->
- Atom;
-e(Str) when is_list(Str) ->
- lists:map(fun($/) ->
- $\\;
- (C) ->
- C
- end,Str).
diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl
deleted file mode 100644
index ab7363c106..0000000000
--- a/lib/test_server/src/ts_erl_config.erl
+++ /dev/null
@@ -1,403 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% Purpose : Updates variable list with variables depending on
-%%% running Erlang system.
-
--module(ts_erl_config).
-
-
--export([variables/2]).
-
-%% Returns a list of key, value pairs.
-
-variables(Base0, OsType) ->
- Base1 = erl_include(Base0),
- Base2 = get_app_vars(fun erl_interface/2, Base1, OsType),
- Base3 = get_app_vars(fun ic/2, Base2, OsType),
- Base4 = get_app_vars(fun jinterface/2, Base3, OsType),
- Base5 = dl_vars(Base4, Base3, OsType),
- Base6 = emu_vars(Base5),
- Base7 = get_app_vars(fun ssl/2, Base6, OsType),
- Base8 = erts_lib(Base7, OsType),
- Base = separators(Base8, OsType),
- [{'EMULATOR', tl(code:objfile_extension())},
- {emu_threads, atom_to_list(erlang:system_info(threads))},
- {type_marker, case is_debug_build() of
- true ->
- ".debug";
- false ->
- ""
- end}
- | Base].
-
-get_app_vars(AppFun, Vars, OsType) ->
- case catch AppFun(Vars,OsType) of
- Res when is_list(Res) ->
- Res;
- {cannot_find_app, App} ->
- io:format("* WARNING: Cannot find ~p!~n", [App]),
- Vars;
- {'EXIT', Reason} ->
- exit(Reason);
- Garbage ->
- exit({unexpected_internal_error, Garbage})
- end.
-
-dl_vars(Vars, Base3, OsType) ->
- ShlibRules0 = ".SUFFIXES:\n" ++
- ".SUFFIXES: @dll@ @obj@ .c\n\n" ++
- ".c@dll@:\n" ++
- "\t@CC@ -c @SHLIB_CFLAGS@ $(SHLIB_EXTRA_CFLAGS) -I@erl_include@ @DEFS@ $<\n" ++
- "\t@SHLIB_LD@ @CROSSLDFLAGS@ @SHLIB_LDFLAGS@ $(SHLIB_EXTRA_LDFLAGS) -o $@ $*@obj@ @SHLIB_LDLIBS@ $(SHLIB_EXTRA_LDLIBS)",
-
- ShlibRules = ts_lib:subst(ShlibRules0, Vars),
- case get_app_vars2(fun jinterface/2, Base3, OsType) of
- {App, not_found} ->
- [{'SHLIB_RULES', ShlibRules}, {App, "not_found"}|Vars];
- _ ->
- [{'SHLIB_RULES', ShlibRules}|Vars]
- end.
-get_app_vars2(AppFun, Vars, OsType) ->
- case catch AppFun(Vars,OsType) of
- Res when is_list(Res) ->
- {jinterface, ok};
- {cannot_find_app, App} ->
- {App, not_found};
- {'EXIT', Reason} ->
- exit(Reason);
- Garbage ->
- exit({unexpected_internal_error, Garbage})
- end.
-
-erts_lib_name(multi_threaded, {win32, V}) ->
- link_library("erts_MD" ++ case is_debug_build() of
- true -> "d";
- false -> ""
- end,
- {win32, V});
-erts_lib_name(single_threaded, {win32, V}) ->
- link_library("erts_ML" ++ case is_debug_build() of
- true -> "d";
- false -> ""
- end,
- {win32, V});
-erts_lib_name(multi_threaded, OsType) ->
- link_library("erts_r", OsType);
-erts_lib_name(single_threaded, OsType) ->
- link_library("erts", OsType).
-
-erts_lib(Vars,OsType) ->
- {ErtsLibInclude,
- ErtsLibIncludeGenerated,
- ErtsLibIncludeInternal,
- ErtsLibIncludeInternalGenerated,
- ErtsLibPath,
- ErtsLibInternalPath,
- ErtsLibEthreadMake,
- ErtsLibInternalMake
- }
- = case erl_root(Vars) of
- {installed, _Root} ->
- Erts = lib_dir(Vars, erts),
- ErtsInclude = filename:join([Erts, "include"]),
- ErtsIncludeInternal = filename:join([ErtsInclude, "internal"]),
- ErtsLib = filename:join([Erts, "lib"]),
- ErtsLibInternal = filename:join([ErtsLib, "internal"]),
- ErtsEthreadMake = filename:join([ErtsIncludeInternal, "ethread.mk"]),
- ErtsInternalMake = filename:join([ErtsIncludeInternal, "erts_internal.mk"]),
-
- {ErtsInclude,
- ErtsInclude,
- ErtsIncludeInternal,
- ErtsIncludeInternal,
- ErtsLib,
- ErtsLibInternal,
- ErtsEthreadMake,
- ErtsInternalMake};
- {srctree, Root, Target} ->
- Erts = filename:join([Root, "erts"]),
- ErtsInclude = filename:join([Erts, "include"]),
- ErtsIncludeTarget = filename:join([ErtsInclude, Target]),
- ErtsIncludeInternal = filename:join([ErtsInclude,
- "internal"]),
- ErtsIncludeInternalTarget = filename:join([ErtsIncludeInternal,
- Target]),
- ErtsLib = filename:join([Erts, "lib", Target]),
- ErtsLibInternal = filename:join([Erts,
- "lib",
- "internal",
- Target]),
- ErtsEthreadMake = filename:join([ErtsIncludeInternalTarget, "ethread.mk"]),
- ErtsInternalMake = filename:join([ErtsIncludeInternalTarget, "erts_internal.mk"]),
-
- {ErtsInclude,
- ErtsIncludeTarget,
- ErtsIncludeInternal,
- ErtsIncludeInternalTarget,
- ErtsLib,
- ErtsLibInternal,
- ErtsEthreadMake,
- ErtsInternalMake}
- end,
- [{erts_lib_include,
- quote(filename:nativename(ErtsLibInclude))},
- {erts_lib_include_generated,
- quote(filename:nativename(ErtsLibIncludeGenerated))},
- {erts_lib_include_internal,
- quote(filename:nativename(ErtsLibIncludeInternal))},
- {erts_lib_include_internal_generated,
- quote(filename:nativename(ErtsLibIncludeInternalGenerated))},
- {erts_lib_path, quote(filename:nativename(ErtsLibPath))},
- {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))},
- {erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)},
- {erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)},
- {erts_lib_make_ethread, quote(ErtsLibEthreadMake)},
- {erts_lib_make_internal, quote(ErtsLibInternalMake)}
- | Vars].
-
-erl_include(Vars) ->
- Include =
- case erl_root(Vars) of
- {installed, Root} ->
- quote(filename:join([Root, "usr", "include"]));
- {srctree, Root, Target} ->
- quote(filename:join([Root, "erts", "emulator", "beam"]))
- ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"]))
- ++ system_include(Root, Vars)
- ++ " -I" ++ quote(filename:join([Root, "erts", "include"]))
- ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target]))
- end,
- [{erl_include, filename:nativename(Include)}|Vars].
-
-
-system_include(Root, Vars) ->
- SysDir =
- case ts_lib:var(os, Vars) of
- "Windows" ++ _T -> "sys/win32";
- _ -> "sys/unix"
- end,
- " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))).
-
-erl_interface(Vars,OsType) ->
- {Incl, {LibPath, MkIncl}} =
- case lib_dir(Vars, erl_interface) of
- {error, bad_name} ->
- throw({cannot_find_app, erl_interface});
- Dir ->
- {filename:join(Dir, "include"),
- case erl_root(Vars) of
- {installed, _Root} ->
- {filename:join(Dir, "lib"),
- filename:join([Dir, "src", "eidefs.mk"])};
- {srctree, _Root, Target} ->
- {filename:join([Dir, "obj", Target]),
- filename:join([Dir, "src", Target, "eidefs.mk"])}
- end}
- end,
- Lib = link_library("erl_interface",OsType),
- Lib1 = link_library("ei",OsType),
- {LibDrv, Lib1Drv} =
- case erlang:system_info(threads) of
- false ->
- case OsType of
- {unix,_} ->
- {link_library("erl_interface_st",OsType),
- link_library("ei_st",OsType)};
- _ ->
- {Lib, Lib1}
- end;
- true ->
- case OsType of
- {win32, _} ->
- {link_library("erl_interface_md",OsType),
- link_library("ei_md",OsType)};
- _ ->
- {Lib, Lib1}
- end
- end,
- ThreadLib = case OsType of
- % FIXME: FreeBSD uses gcc flag '-pthread' or linking with
- % "libc_r". So it has to be last of libs. This is an
- % temporary solution, should be configured elsewhere.
-
- % This temporary solution have now failed!
- % A new temporary solution is installed ...
- % {unix,freebsd} -> "-lc_r";
- {unix,freebsd} ->
- "-lpthread";
- {unix,_} ->
- "-lpthread";
- _ ->
- ""
- end,
- [{erl_interface_libpath, quote(filename:nativename(LibPath))},
- {erl_interface_sock_libs, sock_libraries(OsType)},
- {erl_interface_lib, quote(filename:join(LibPath, Lib))},
- {erl_interface_eilib, quote(filename:join(LibPath, Lib1))},
- {erl_interface_lib_drv, quote(filename:join(LibPath, LibDrv))},
- {erl_interface_eilib_drv, quote(filename:join(LibPath, Lib1Drv))},
- {erl_interface_threadlib, ThreadLib},
- {erl_interface_include, quote(filename:nativename(Incl))},
- {erl_interface_mk_include, quote(filename:nativename(MkIncl))}
- | Vars].
-
-ic(Vars, OsType) ->
- {ClassPath, LibPath, Incl} =
- case lib_dir(Vars, ic) of
- {error, bad_name} ->
- throw({cannot_find_app, ic});
- Dir ->
- {filename:join([Dir, "priv", "ic.jar"]),
- case erl_root(Vars) of
- {installed, _Root} ->
- filename:join([Dir, "priv", "lib"]);
- {srctree, _Root, Target} ->
- filename:join([Dir, "priv", "lib", Target])
- end,
- filename:join(Dir, "include")}
- end,
- [{ic_classpath, quote(filename:nativename(ClassPath))},
- {ic_libpath, quote(filename:nativename(LibPath))},
- {ic_lib, quote(filename:join(filename:nativename(LibPath),link_library("ic", OsType)))},
- {ic_include_path, quote(filename:nativename(Incl))}|Vars].
-
-jinterface(Vars, _OsType) ->
- ClassPath =
- case lib_dir(Vars, jinterface) of
- {error, bad_name} ->
- throw({cannot_find_app, jinterface});
- Dir ->
- filename:join([Dir, "priv", "OtpErlang.jar"])
- end,
- [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars].
-
-lib_dir(Vars, Lib) ->
- LibLibDir = case Lib of
- erts ->
- filename:join([code:root_dir(),
- "erts-" ++ erlang:system_info(version)]);
- _ ->
- code:lib_dir(Lib)
- end,
- case {get_var(crossroot, Vars), LibLibDir} of
- {{error, _}, _} -> %no crossroot
- LibLibDir;
- {CrossRoot, _} ->
- %% XXX: Ugly. So ugly I won't comment it
- %% /Patrik
- CLibDirList = case Lib of
- erts ->
- [CrossRoot, "erts"];
- _ ->
- [CrossRoot, "lib", atom_to_list(Lib)]
- end,
- CLibDir = filename:join(CLibDirList),
- Cmd = "ls -d " ++ CLibDir ++ "*",
- XLibDir = lists:last(string:tokens(os:cmd(Cmd),"\n")),
- case file:list_dir(XLibDir) of
- {error, enoent} ->
- [];
- _ ->
- XLibDir
- end
- end.
-
-erl_root(Vars) ->
- Root = case get_var(crossroot,Vars) of
- {error, notfound} -> code:root_dir();
- CrossRoot -> CrossRoot
- end,
- case ts_lib:erlang_type(Root) of
- {srctree, _Version} ->
- Target = get_var(target, Vars),
- {srctree, Root, Target};
- {_, _Version} ->
- {installed, Root}
- end.
-
-
-get_var(Key, Vars) ->
- case lists:keysearch(Key, 1, Vars) of
- {value, {Key, Value}} ->
- Value;
- _ ->
- {error, notfound}
- end.
-
-
-sock_libraries({win32, _}) ->
- "ws2_32.lib";
-sock_libraries({unix, _}) ->
- "". % Included in general libraries if needed.
-
-link_library(LibName,{win32, _}) ->
- LibName ++ ".lib";
-link_library(LibName,{unix, _}) ->
- "lib" ++ LibName ++ ".a";
-link_library(_LibName,_Other) ->
- exit({link_library, not_supported}).
-
-%% Returns emulator specific variables.
-emu_vars(Vars) ->
- [{is_source_build, is_source_build()},
- {erl_name, atom_to_list(lib:progname())}|Vars].
-
-is_source_build() ->
- string:str(erlang:system_info(system_version), "[source]") > 0.
-
-is_debug_build() ->
- case catch string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 ->
- true;
- _ ->
- false
- end.
-%%
-%% ssl_libdir
-%%
-ssl(Vars, _OsType) ->
- case lib_dir(Vars, ssl) of
- {error, bad_name} ->
- throw({cannot_find_app, ssl});
- Dir ->
- [{ssl_libdir, quote(filename:nativename(Dir))}| Vars]
- end.
-
-separators(Vars, {win32,_}) ->
- [{'DS',"\\"},{'PS',";"}|Vars];
-separators(Vars, _) ->
- [{'DS',"/"},{'PS',":"}|Vars].
-
-quote(List) ->
- case lists:member($ , List) of
- false -> List;
- true -> make_quote(List)
- end.
-
-make_quote(List) ->
- case os:type() of
- {win32, _} -> %% nmake"
- [$"] ++ List ++ [$"];
- _ -> %% make
- BackQuote = fun($ , Acc) -> [$\\ , $ |Acc];
- (Char, Acc) -> [Char|Acc] end,
- lists:foldr(BackQuote, [], List)
- end.
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
deleted file mode 100644
index 600a576820..0000000000
--- a/lib/test_server/src/ts_install.erl
+++ /dev/null
@@ -1,465 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ts_install).
-
--export([install/2, platform_id/1]).
-
--include("ts.hrl").
--include_lib("kernel/include/file.hrl").
-
-install(install_local, Options) ->
- install(os:type(), Options);
-
-install(TargetSystem, Options) ->
- case file:consult(?variables) of
- {ok, Vars} ->
- case proplists:get_value(cross,Vars) of
- "yes" when Options == []->
- target_install(Vars);
- _ ->
- build_install(TargetSystem, Options)
- end;
- _ ->
- build_install(TargetSystem, Options)
- end.
-
-
-build_install(TargetSystem, Options) ->
- XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)),
- case autoconf(TargetSystem, XComp++Options) of
- {ok, Vars0} ->
- OsType = os_type(TargetSystem),
- Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType),
- {Options1, Vars2} = add_vars(Vars1, Options),
- Vars3 = lists:flatten([Options1|Vars2]),
- write_terms(?variables, Vars3);
- {error, Reason} ->
- {error, Reason}
- end.
-
-os_type({unix,_}=OsType) -> OsType;
-os_type({win32,_}=OsType) -> OsType.
-
-target_install(CrossVars) ->
- io:format("Cross installation detected, skipping configure and data_dir make~n"),
- case file:rename(?variables,?cross_variables) of
- ok ->
- ok;
- _ ->
- io:format("Could not find variables file from cross make~n"),
- throw(cross_installation_failed)
- end,
- CPU = proplists:get_value('CPU',CrossVars),
- OS = proplists:get_value(os,CrossVars),
- {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]),
- Variables = lists:flatten([Options|Vars]),
- write_terms(?variables, Variables).
-
-%% Autoconf for various platforms.
-%% unix uses the configure script
-%% win32 uses ts_autoconf_win32
-
-autoconf(TargetSystem, XComp) ->
- case autoconf1(TargetSystem, XComp) of
- ok ->
- autoconf2(file:read_file("conf_vars"));
- Error ->
- Error
- end.
-
-autoconf1({win32, _},[{cross,"no"}]) ->
- ts_autoconf_win32:configure();
-autoconf1({unix, _},XCompFile) ->
- unix_autoconf(XCompFile);
-autoconf1(_,_) ->
- io:format("cross compilation not supported for that this platform~n"),
- throw(cross_installation_failed).
-
-autoconf2({ok, Bin}) ->
- get_vars(ts_lib:b2s(Bin), name, [], []);
-autoconf2(Error) ->
- Error.
-
-get_vars([$:|Rest], name, Current, Result) ->
- Name = list_to_atom(lists:reverse(Current)),
- get_vars(Rest, value, [], [Name|Result]);
-get_vars([$\r|Rest], value, Current, Result) ->
- get_vars(Rest, value, Current, Result);
-get_vars([$\n|Rest], value, Current, [Name|Result]) ->
- Value = lists:reverse(Current),
- get_vars(Rest, name, [], [{Name, Value}|Result]);
-get_vars([C|Rest], State, Current, Result) ->
- get_vars(Rest, State, [C|Current], Result);
-get_vars([], name, [], Result) ->
- {ok, Result};
-get_vars(_, _, _, _) ->
- {error, fatal_bad_conf_vars}.
-
-config_flags() ->
- case os:getenv("CONFIG_FLAGS") of
- false -> [];
- CF -> string:tokens(CF, " \t\n")
- end.
-
-unix_autoconf(XConf) ->
- Configure = filename:absname("configure"),
- Flags = proplists:get_value(crossflags,XConf,[]),
- Env = proplists:get_value(crossenv,XConf,[]),
- Host = get_xcomp_flag("host", Flags),
- Build = get_xcomp_flag("build", Flags),
- Threads = [" --enable-shlib-thread-safety" ||
- erlang:system_info(threads) /= false],
- Debug = [" --enable-debug-mode" ||
- string:str(erlang:system_info(system_version),"debug") > 0],
- MXX_Build = [Y || Y <- config_flags(),
- Y == "--enable-m64-build"
- orelse Y == "--enable-m32-build"],
- Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build,
- case filelib:is_file(Configure) of
- true ->
- OSXEnv = macosx_cflags(),
- UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)),
- io:format("Running ~s~nEnv: ~p~n",
- [lists:flatten(Configure ++ Args),UnQuotedEnv]),
- Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])},
- [stream, eof, {env,UnQuotedEnv}]),
- ts_lib:print_data(Port);
- false ->
- {error, no_configure_script}
- end.
-
-unquote([{Var,Val}|T]) ->
- [{Var,unquote(Val)}|unquote(T)];
-unquote([]) ->
- [];
-unquote("\""++Rest) ->
- lists:reverse(tl(lists:reverse(Rest)));
-unquote(String) ->
- String.
-
-assign_vars([]) ->
- [];
-assign_vars([{VAR,FlagsStr} | VARs]) ->
- [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)];
-assign_vars(FlagsStr) ->
- Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])],
- string:strip(lists:flatten(lists:map(fun(Flag) ->
- Flag ++ " "
- end, Flags)), right).
-
-assign_all_vars([$$ | Rest], FlagSoFar) ->
- {VarName,Rest1} = get_var_name(Rest, []),
- assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName));
-assign_all_vars([Char | Rest], FlagSoFar) ->
- assign_all_vars(Rest, FlagSoFar ++ [Char]);
-assign_all_vars([], Flag) ->
- Flag.
-
-get_var_name([Ch | Rest] = Str, VarR) ->
- case valid_char(Ch) of
- true -> get_var_name(Rest, [Ch | VarR]);
- false -> {lists:reverse(VarR),Str}
- end;
-get_var_name([], VarR) ->
- {lists:reverse(VarR),[]}.
-
-assign_var(VarName) ->
- case os:getenv(VarName) of
- false -> "";
- Val -> Val
- end.
-
-valid_char(Ch) when Ch >= $a, Ch =< $z -> true;
-valid_char(Ch) when Ch >= $A, Ch =< $Z -> true;
-valid_char(Ch) when Ch >= $0, Ch =< $9 -> true;
-valid_char($_) -> true;
-valid_char(_) -> false.
-
-get_xcomp_flag(Flag, Flags) ->
- get_xcomp_flag(Flag, Flag, Flags).
-get_xcomp_flag(Flag, Tag, Flags) ->
- case proplists:get_value(Flag,Flags) of
- undefined -> "";
- "guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")];
- HostVal -> [" --",Tag,"=",HostVal]
- end.
-
-
-macosx_cflags() ->
- case os:type() of
- {unix, darwin} ->
- %% To ensure that the drivers we build can be loaded
- %% by the emulator, add either -m32 or -m64 to CFLAGS.
- WordSize = erlang:system_info(wordsize),
- Mflag = "-m" ++ integer_to_list(8*WordSize),
- [{"CFLAGS", Mflag},{"LDFLAGS", Mflag}];
- _ ->
- []
- end.
-
-parse_xcomp_file(undefined) ->
- [{cross,"no"}];
-parse_xcomp_file(Filepath) ->
- {ok,Bin} = file:read_file(Filepath),
- Lines = binary:split(Bin,<<"\n">>,[global,trim]),
- {Envs,Flags} = parse_xcomp_file(Lines,[],[]),
- [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")},
- {crossenv,Envs},{crossflags,Flags}].
-
-parse_xcomp_file([<<A:8,_/binary>> = Line|R],Envs,Flags)
- when $A =< A, A =< $Z ->
- [Var,Value] = binary:split(Line,<<"=">>),
- parse_xcomp_file(R,[{ts_lib:b2s(Var),
- ts_lib:b2s(Value)}|Envs],Flags);
-parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) ->
- [Var,Value] = binary:split(Line,<<"=">>),
- parse_xcomp_file(R,Envs,[{ts_lib:b2s(Var),
- ts_lib:b2s(Value)}|Flags]);
-parse_xcomp_file([_|R],Envs,Flags) ->
- parse_xcomp_file(R,Envs,Flags);
-parse_xcomp_file([],Envs,Flags) ->
- {lists:reverse(Envs),lists:reverse(Flags)}.
-
-write_terms(Name, Terms) ->
- case file:open(Name, [write]) of
- {ok, Fd} ->
- Result = write_terms1(Fd, remove_duplicates(Terms)),
- file:close(Fd),
- Result;
- {error, Reason} ->
- {error, Reason}
- end.
-
-write_terms1(Fd, [Term|Rest]) ->
- ok = io:format(Fd, "~p.\n", [Term]),
- write_terms1(Fd, Rest);
-write_terms1(_, []) ->
- ok.
-
-remove_duplicates(List) ->
- lists:reverse(
- lists:foldl(fun({Key,Val},Acc) ->
- R = make_ref(),
- case proplists:get_value(Key,Acc,R) of
- R -> [{Key,Val}|Acc];
- _Else ->
- Acc
- end
- end,[],List)).
-
-add_vars(Vars0, Opts0) ->
- {Opts,LongNames} =
- case lists:keymember(longnames, 1, Opts0) of
- true ->
- {lists:keydelete(longnames, 1, Opts0),true};
- false ->
- {Opts0,false}
- end,
- {PlatformId, PlatformLabel, PlatformFilename, Version} =
- platform([{longnames, LongNames}|Vars0]),
- NetDir = lists:concat(["/net", hostname()]),
- Mounted = case file:read_file_info(NetDir) of
- {ok, #file_info{type = directory}} -> NetDir;
- _ -> ""
- end,
- {Opts, [{longnames, LongNames},
- {platform_id, PlatformId},
- {platform_filename, PlatformFilename},
- {rsh_name, get_rsh_name()},
- {platform_label, PlatformLabel},
- {ts_net_dir, Mounted},
- {erl_flags, []},
- {erl_release, Version},
- {ts_testcase_callback, get_testcase_callback()} | Vars0]}.
-
-get_testcase_callback() ->
- case os:getenv("TS_TESTCASE_CALLBACK") of
- ModFunc when is_list(ModFunc), ModFunc /= "" ->
- case string:tokens(ModFunc, " ") of
- [_Mod,_Func] -> ModFunc;
- _ -> ""
- end;
- _ ->
- case init:get_argument(ts_testcase_callback) of
- {ok,[[Mod,Func]]} -> Mod ++ " " ++ Func;
- _ -> ""
- end
- end.
-
-get_rsh_name() ->
- case os:getenv("ERL_RSH") of
- false -> "rsh";
- Str -> Str
- end.
-
-platform_id(Vars) ->
- {Id,_,_,_} = platform(Vars),
- Id.
-
-platform(Vars) ->
- Hostname = hostname(),
-
- {Type,Version} = ts_lib:erlang_type(),
- Cpu = ts_lib:var('CPU', Vars),
- Os = ts_lib:var(os, Vars),
-
- ErlType = to_upper(atom_to_list(Type)),
- OsType = ts_lib:initial_capital(Os),
- CpuType = ts_lib:initial_capital(Cpu),
- LinuxDist = linux_dist(),
- ExtraLabel = extra_platform_label(),
- Schedulers = schedulers(),
- BindType = bind_type(),
- KP = kernel_poll(),
- IOTHR = io_thread(),
- LC = lock_checking(),
- MT = modified_timing(),
- AsyncThreads = async_threads(),
- Debug = debug(),
- CpuBits = word_size(),
- Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist,
- Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads,
- Debug,ExtraLabel]),
- PlatformId = lists:concat([ErlType, " ", Version, Common]),
- PlatformLabel = ErlType ++ Common,
- PlatformFilename = platform_as_filename(PlatformId),
- {PlatformId, PlatformLabel, PlatformFilename, Version}.
-
-platform_as_filename(Label) ->
- lists:map(fun($ ) -> $_;
- ($/) -> $_;
- (C) when $A =< C, C =< $Z -> C - $A + $a;
- (C) -> C end,
- Label).
-
-to_upper(String) ->
- lists:map(fun(C) when $a =< C, C =< $z -> C - $a + $A;
- (C) -> C end,
- String).
-
-word_size() ->
- case {erlang:system_info({wordsize,external}),
- erlang:system_info({wordsize,internal})} of
- {4,4} -> "";
- {8,8} -> "/64";
- {8,4} -> "/Halfword"
- end.
-
-linux_dist() ->
- case os:type() of
- {unix,linux} ->
- linux_dist_1([fun linux_dist_suse/0]);
- _ -> ""
- end.
-
-linux_dist_1([F|T]) ->
- case F() of
- "" -> linux_dist_1(T);
- Str -> Str
- end;
-linux_dist_1([]) -> "".
-
-linux_dist_suse() ->
- case filelib:is_file("/etc/SuSE-release") of
- false -> "";
- true ->
- Ver0 = os:cmd("awk '/^VERSION/ {print $3}' /etc/SuSE-release"),
- [_|Ver1] = lists:reverse(Ver0),
- Ver = lists:reverse(Ver1),
- "/Suse" ++ Ver
- end.
-
-hostname() ->
- case catch inet:gethostname() of
- {ok, Hostname} when is_list(Hostname) ->
- "/" ++ lists:takewhile(fun (C) -> C /= $. end, Hostname);
- _ ->
- "/localhost"
- end.
-
-async_threads() ->
- case catch erlang:system_info(threads) of
- true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size));
- _ -> ""
- end.
-
-schedulers() ->
- case catch erlang:system_info(smp_support) of
- true ->
- case {erlang:system_info(schedulers),
- erlang:system_info(schedulers_online)} of
- {S,S} ->
- "/S"++integer_to_list(S);
- {S,O} ->
- "/S"++integer_to_list(S) ++ ":" ++
- integer_to_list(O)
- end;
- _ -> ""
- end.
-
-bind_type() ->
- case catch erlang:system_info(scheduler_bind_type) of
- thread_no_node_processor_spread -> "/sbttnnps";
- no_node_processor_spread -> "/sbtnnps";
- no_node_thread_spread -> "/sbtnnts";
- processor_spread -> "/sbtps";
- thread_spread -> "/sbtts";
- no_spread -> "/sbtns";
- _ -> ""
- end.
-
-
-debug() ->
- case string:str(erlang:system_info(system_version), "debug") of
- 0 -> "";
- _ -> "/Debug"
- end.
-
-lock_checking() ->
- case catch erlang:system_info(lock_checking) of
- true -> "/LC";
- _ -> ""
- end.
-
-modified_timing() ->
- case catch erlang:system_info(modified_timing_level) of
- N when is_integer(N) ->
- "/T" ++ integer_to_list(N);
- _ -> ""
- end.
-
-kernel_poll() ->
- case catch erlang:system_info(kernel_poll) of
- true -> "/KP";
- _ -> ""
- end.
-
-io_thread() ->
- case catch erlang:system_info(io_thread) of
- true -> "/IOTHR";
- _ -> ""
- end.
-
-extra_platform_label() ->
- case os:getenv("TS_EXTRA_PLATFORM_LABEL") of
- [] -> "";
- [_|_]=Label -> "/" ++ Label;
- false -> ""
- end.
diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl
deleted file mode 100644
index ec0d54ccde..0000000000
--- a/lib/test_server/src/ts_install_cth.erl
+++ /dev/null
@@ -1,253 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% @doc TS Installed SCB
-%%%
-%%% This module does what the make parts of the ts:run/x command did,
-%%% but not the Makefile.first parts! So they have to be done by ts or
-%%% manually!!
-
--module(ts_install_cth).
-
-%% Suite Callbacks
--export([id/1]).
--export([init/2]).
-
--export([pre_init_per_suite/3]).
--export([post_init_per_suite/4]).
--export([pre_end_per_suite/3]).
--export([post_end_per_suite/4]).
-
--export([pre_init_per_group/3]).
--export([post_init_per_group/4]).
--export([pre_end_per_group/3]).
--export([post_end_per_group/4]).
-
--export([pre_init_per_testcase/3]).
--export([post_end_per_testcase/4]).
-
--export([on_tc_fail/3]).
--export([on_tc_skip/3]).
-
--export([terminate/1]).
-
--include_lib("kernel/include/file.hrl").
-
--type config() :: proplists:proplist().
--type reason() :: term().
--type skip_or_fail() :: {skip, reason()} |
- {auto_skip, reason()} |
- {fail, reason()}.
-
--record(state, { ts_conf_dir, target_system, install_opts, nodenames, nodes }).
-
-%% @doc The id of this SCB
--spec id(Opts :: term()) ->
- Id :: term().
-id(_Opts) ->
- ?MODULE.
-
-%% @doc Always called before any other callback function.
--spec init(Id :: term(), Opts :: proplists:proplist()) ->
- {ok, State :: #state{}}.
-init(_Id, Opts) ->
- Nodenames = proplists:get_value(nodenames, Opts, 0),
- Nodes = proplists:get_value(nodes, Opts, 0),
- TSConfDir = proplists:get_value(ts_conf_dir, Opts),
- TargetSystem = proplists:get_value(target_system, Opts, install_local),
- InstallOpts = proplists:get_value(install_opts, Opts, []),
- {ok, #state{ nodenames = Nodenames,
- nodes = Nodes,
- ts_conf_dir = TSConfDir,
- target_system = TargetSystem,
- install_opts = InstallOpts } }.
-
-%% @doc Called before init_per_suite is called.
--spec pre_init_per_suite(Suite :: atom(),
- Config :: config(),
- State :: #state{}) ->
- {config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) ->
- DataDir = proplists:get_value(data_dir, Config),
- ParentDir = filename:join(
- lists:reverse(
- tl(lists:reverse(filename:split(DataDir))))),
- TSConfDir = filename:join([ParentDir, "..","test_server"]),
- pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir });
-pre_init_per_suite(_Suite,Config,State) ->
- DataDir = proplists:get_value(data_dir, Config),
- try
- {ok,Variables} =
- file:consult(filename:join(State#state.ts_conf_dir,"variables")),
- case proplists:get_value(cross,Variables) of
- "yes" ->
- ct:log("Not making data dir as tests have been cross compiled");
- _ ->
- ts_lib:make_non_erlang(DataDir, Variables)
- end,
-
- {add_node_name(Config, State), State}
- catch error:{badmatch,{error,enoent}} ->
- {add_node_name(Config, State), State};
- Error:Reason ->
- Stack = erlang:get_stacktrace(),
- ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]),
- {{fail,{?MODULE,{Error,Reason, Stack}}},State}
- end.
-
-%% @doc Called after init_per_suite.
--spec post_init_per_suite(Suite :: atom(),
- Config :: config(),
- Return :: config() | skip_or_fail(),
- State :: #state{}) ->
- {config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_suite(_Suite,_Config,Return,State) ->
- test_server_ctrl:kill_slavenodes(),
- {Return, State}.
-
-%% @doc Called before end_per_suite.
--spec pre_end_per_suite(Suite :: atom(),
- Config :: config() | skip_or_fail(),
- State :: #state{}) ->
- {ok | skip_or_fail(), NewState :: #state{}}.
-pre_end_per_suite(_Suite,Config,State) ->
- {Config, State}.
-
-%% @doc Called after end_per_suite.
--spec post_end_per_suite(Suite :: atom(),
- Config :: config(),
- Return :: term(),
- State :: #state{}) ->
- {ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_suite(_Suite,_Config,Return,State) ->
- {Return, State}.
-
-%% @doc Called before each init_per_group.
--spec pre_init_per_group(Group :: atom(),
- Config :: config(),
- State :: #state{}) ->
- {config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_group(_Group,Config,State) ->
- {add_node_name(Config, State), State}.
-
-%% @doc Called after each init_per_group.
--spec post_init_per_group(Group :: atom(),
- Config :: config(),
- Return :: config() | skip_or_fail(),
- State :: #state{}) ->
- {config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_group(_Group,_Config,Return,State) ->
- {Return, State}.
-
-%% @doc Called after each end_per_group.
--spec pre_end_per_group(Group :: atom(),
- Config :: config() | skip_or_fail(),
- State :: #state{}) ->
- {ok | skip_or_fail(), NewState :: #state{}}.
-pre_end_per_group(_Group,Config,State) ->
- {Config, State}.
-
-%% @doc Called after each end_per_group.
--spec post_end_per_group(Group :: atom(),
- Config :: config(),
- Return :: term(),
- State :: #state{}) ->
- {ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_group(_Group,_Config,Return,State) ->
- {Return, State}.
-
-%% @doc Called before each test case.
--spec pre_init_per_testcase(TC :: atom(),
- Config :: config(),
- State :: #state{}) ->
- {config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_testcase(_TC,Config,State) ->
- {add_node_name(Config, State), State}.
-
-%% @doc Called after each test case.
--spec post_end_per_testcase(TC :: atom(),
- Config :: config(),
- Return :: term(),
- State :: #state{}) ->
- {ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_testcase(_TC,_Config,Return,State) ->
- {Return, State}.
-
-%% @doc Called after a test case failed.
--spec on_tc_fail(TC :: init_per_suite | end_per_suite |
- init_per_group | end_per_group | atom(),
- Reason :: term(), State :: #state{}) ->
- NewState :: #state{}.
-on_tc_fail(_TC, _Reason, State) ->
- State.
-
-%% @doc Called when a test case is skipped.
--spec on_tc_skip(TC :: end_per_suite | init_per_group | end_per_group | atom(),
- {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(),
- Reason :: term()}}} |
- {tc_user_skip, {skipped, Reason :: term()}},
- State :: #state{}) ->
- NewState :: #state{}.
-on_tc_skip(_TC, _Reason, State) ->
- State.
-
-%% @doc Called when the scope of the SCB is done.
--spec terminate(State :: #state{}) ->
- term().
-terminate(_State) ->
- ok.
-
-%%% ============================================================================
-%%% Local functions
-%%% ============================================================================
-
-%% Add a nodename to config if it does not exist
-add_node_name(Config, State) ->
- case proplists:get_value(nodenames, Config) of
- undefined ->
- lists:keystore(
- nodenames, 1, Config,
- {nodenames,generate_nodenames(State#state.nodenames)});
- _Else ->
- Config
- end.
-
-
-%% Copied from test_server_ctrl.erl
-generate_nodenames(Num) ->
- {ok,Name} = inet:gethostname(),
- generate_nodenames2(Num, [Name], []).
-
-generate_nodenames2(0, _Hosts, Acc) ->
- Acc;
-generate_nodenames2(N, Hosts, Acc) ->
- Host=lists:nth((N rem (length(Hosts)))+1, Hosts),
- Name=list_to_atom(temp_nodename("nod",N) ++ "@" ++ Host),
- generate_nodenames2(N-1, Hosts, [Name|Acc]).
-
-%% We cannot use erlang:unique_integer([positive])
-%% here since this code in run on older test releases as well.
-temp_nodename(Base,I) ->
- {A,B,C} = os:timestamp(),
- Nstr = integer_to_list(I),
- Astr = integer_to_list(A),
- Bstr = integer_to_list(B),
- Cstr = integer_to_list(C),
- Base++Nstr++Astr++Bstr++Cstr.
diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl
deleted file mode 100644
index 7c3f450194..0000000000
--- a/lib/test_server/src/ts_lib.erl
+++ /dev/null
@@ -1,372 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ts_lib).
-
--include_lib("kernel/include/file.hrl").
--include("ts.hrl").
-
-%% Avoid warning for local function error/1 clashing with autoimported BIF.
--compile({no_auto_import,[error/1]}).
--export([error/1, var/2, erlang_type/0,
- erlang_type/1,
- initial_capital/1,
- specs/1, suites/2,
- test_categories/2, specialized_specs/2,
- subst_file/3, subst/2, print_data/1,
- make_non_erlang/2,
- maybe_atom_to_list/1, progress/4,
- b2s/1
- ]).
-
-error(Reason) ->
- throw({error, Reason}).
-
-%% Returns the value for a variable
-
-var(Name, Vars) ->
- case lists:keysearch(Name, 1, Vars) of
- {value, {Name, Value}} ->
- Value;
- false ->
- error({bad_installation, {undefined_var, Name, Vars}})
- end.
-
-%% Returns the level of verbosity (0-X)
-verbosity(Vars) ->
- % Check for a single verbose option.
- case lists:member(verbose, Vars) of
- true ->
- 1;
- false ->
- case lists:keysearch(verbose, 1, Vars) of
- {value, {verbose, Level}} ->
- Level;
- _ ->
- 0
- end
- end.
-
-% Displays output to the console if verbosity is equal or more
-% than Level.
-progress(Vars, Level, Format, Args) ->
- V=verbosity(Vars),
- if
- V>=Level ->
- io:format(Format, Args);
- true ->
- ok
- end.
-
-%% Returns: {Type, Version} where Type is otp|src
-
-erlang_type() ->
- erlang_type(code:root_dir()).
-erlang_type(RootDir) ->
- {_, Version} = init:script_id(),
- RelDir = filename:join(RootDir, "releases"), % Only in installed
- case filelib:is_file(RelDir) of
- true -> {otp,Version}; % installed OTP
- false -> {srctree,Version} % source code tree
- end.
-
-%% Upcases the first letter in a string.
-
-initial_capital([C|Rest]) when $a =< C, C =< $z ->
- [C-$a+$A|Rest];
-initial_capital(String) ->
- String.
-
-specialized_specs(Dir,PostFix) ->
- Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
- "*_test", "*_"++PostFix++".spec"])),
- sort_tests([begin
- DirPart = filename:dirname(Name),
- AppTest = hd(lists:reverse(filename:split(DirPart))),
- list_to_atom(string:substr(AppTest, 1, length(AppTest)-5))
- end || Name <- Specs]).
-
-specs(Dir) ->
- Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
- "*_test", "*.{dyn,}spec"])),
- %% Make sure only to include the main spec for each application
- MainSpecs =
- lists:flatmap(fun(FullName) ->
- [Spec,TestDir|_] =
- lists:reverse(filename:split(FullName)),
- [_TestSuffix|TDParts] =
- lists:reverse(string:tokens(TestDir,[$_,$.])),
- [_SpecSuffix|SParts] =
- lists:reverse(string:tokens(Spec,[$_,$.])),
- if TDParts == SParts ->
- [filename_to_atom(FullName)];
- true ->
- []
- end
- end, Specs),
- sort_tests(MainSpecs).
-
-test_categories(Dir, App) ->
- Specs = filelib:wildcard(filename:join([filename:dirname(Dir),
- App++"_test", "*.spec"])),
- lists:flatmap(fun(FullName) ->
- [Spec,_TestDir|_] =
- lists:reverse(filename:split(FullName)),
- case filename:rootname(Spec -- App) of
- "" ->
- [];
- [_Sep | Cat] ->
- [list_to_atom(Cat)]
- end
- end, Specs).
-
-suites(Dir, App) ->
- Glob=filename:join([filename:dirname(Dir), App++"_test",
- "*_SUITE.erl"]),
- Suites=filelib:wildcard(Glob),
- [filename_to_atom(Name) || Name <- Suites].
-
-filename_to_atom(Name) ->
- list_to_atom(filename:rootname(filename:basename(Name))).
-
-%% Sorts a list of either log files directories or spec files.
-
-sort_tests(Tests) ->
- Sorted = lists:usort([{suite_order(filename_to_atom(X)), X} ||
- X <- Tests]),
- [X || {_, X} <- Sorted].
-
-%% This defines the order in which tests should be run and be presented
-%% in index files.
-
-suite_order(emulator) -> 0;
-suite_order(test_server) -> 1;
-suite_order(kernel) -> 4;
-suite_order(stdlib) -> 6;
-suite_order(compiler) -> 8;
-suite_order(hipe) -> 9;
-suite_order(erl_interface) -> 12;
-suite_order(jinterface) -> 14;
-suite_order(sasl) -> 16;
-suite_order(tools) -> 18;
-suite_order(runtime_tools) -> 19;
-suite_order(parsetools) -> 20;
-suite_order(debugger) -> 22;
-suite_order(ic) -> 24;
-suite_order(orber) -> 26;
-suite_order(inets) -> 28;
-suite_order(asn1) -> 30;
-suite_order(os_mon) -> 32;
-suite_order(snmp) -> 38;
-suite_order(mnesia) -> 44;
-suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last!
-suite_order(_) -> 200.
-
-%% Substitute all occurrences of @var@ in the In file, using
-%% the list of variables in Vars, producing the output file Out.
-%% Returns: ok | {error, Reason}
-
-subst_file(In, Out, Vars) ->
- case file:read_file(In) of
- {ok, Bin} ->
- Subst = subst(b2s(Bin), Vars, []),
- case file:write_file(Out, unicode:characters_to_binary(Subst)) of
- ok ->
- ok;
- {error, Reason} ->
- {error, {file_write, Reason}}
- end;
- Error ->
- Error
- end.
-
-subst(String, Vars) ->
- subst(String, Vars, []).
-
-subst([$@, $_|Rest], Vars, Result) ->
- subst_var([$_|Rest], Vars, Result, []);
-subst([$@, C|Rest], Vars, Result) when $A =< C, C =< $Z ->
- subst_var([C|Rest], Vars, Result, []);
-subst([$@, C|Rest], Vars, Result) when $a =< C, C =< $z ->
- subst_var([C|Rest], Vars, Result, []);
-subst([C|Rest], Vars, Result) ->
- subst(Rest, Vars, [C|Result]);
-subst([], _Vars, Result) ->
- lists:reverse(Result).
-
-subst_var([$@|Rest], Vars, Result, VarAcc) ->
- Key = list_to_atom(lists:reverse(VarAcc)),
- {Result1,Rest1} = do_subst_var(Key, Rest, Vars, Result, VarAcc),
- subst(Rest1, Vars, Result1);
-
-subst_var([C|Rest], Vars, Result, VarAcc) ->
- subst_var(Rest, Vars, Result, [C|VarAcc]);
-subst_var([], Vars, Result, VarAcc) ->
- subst([], Vars, [VarAcc++[$@|Result]]).
-
-%% handle conditional
-do_subst_var(Cond, Rest, Vars, Result, _VarAcc) when Cond == 'IFEQ' ;
- Cond == 'IFNEQ' ->
- {Bool,Comment,Rest1} = do_test(Rest, Vars, Cond),
- Rest2 = extract_clause(Bool, Rest1),
- {lists:reverse(Comment, Result),Rest2};
-%% variable substitution
-do_subst_var(Key, Rest, Vars, Result, VarAcc) ->
- case lists:keysearch(Key, 1, Vars) of
- {value, {Key, Value}} ->
- {lists:reverse(Value, Result),Rest};
- false ->
- {[$@|VarAcc++[$@|Result]],Rest}
- end.
-
-%% check arguments in "@IF[N]EQ@ (Arg1, Arg2)" for equality
-do_test(Rest, Vars, Test) ->
- {Arg1,Rest1} = get_arg(Rest, Vars, $,, []),
- {Arg2,Rest2} = get_arg(Rest1, Vars, 41, []), % $)
- Result = case Arg1 of
- Arg2 when Test == 'IFEQ' -> true;
- Arg2 when Test == 'IFNEQ' -> false;
- _ when Test == 'IFNEQ' -> true;
- _ -> false
- end,
- Comment = io_lib:format("# Result of test: ~s (~s, ~s) -> ~w",
- [atom_to_list(Test),Arg1,Arg2,Result]),
- {Result,Comment,Rest2}.
-
-%% extract an argument
-get_arg([$(|Rest], Vars, Stop, _) ->
- get_arg(Rest, Vars, Stop, []);
-get_arg([Stop|Rest], Vars, Stop, Acc) ->
- Arg = string:strip(lists:reverse(Acc)),
- Subst = subst(Arg, Vars),
- {Subst,Rest};
-get_arg([C|Rest], Vars, Stop, Acc) ->
- get_arg(Rest, Vars, Stop, [C|Acc]).
-
-%% keep only the true or false conditional clause
-extract_clause(true, Rest) ->
- extract_clause(true, Rest, []);
-extract_clause(false, Rest) ->
- Rest1 = discard_clause(Rest), % discard true clause
- extract_clause(false, Rest1, []).
-
-%% true clause buffered, done
-extract_clause(true, [$@,$E,$L,$S,$E,$@|Rest], Acc) ->
- Rest1 = discard_clause(Rest), % discard false clause
- lists:reverse(Acc, Rest1);
-%% buffering of false clause starts now
-extract_clause(false, [$@,$E,$L,$S,$E,$@|Rest], _Acc) ->
- extract_clause(false, Rest, []);
-%% true clause buffered, done
-extract_clause(true, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
- lists:reverse(Acc, Rest);
-%% false clause buffered, done
-extract_clause(false, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) ->
- lists:reverse(Acc, Rest);
-%% keep buffering
-extract_clause(Bool, [C|Rest], Acc) ->
- extract_clause(Bool, Rest, [C|Acc]);
-%% parse error
-extract_clause(_, [], Acc) ->
- lists:reverse(Acc).
-
-discard_clause([$@,$E,$L,$S,$E,$@|Rest]) ->
- Rest;
-discard_clause([$@,$E,$N,$D,$I,$F,$@|Rest]) ->
- Rest;
-discard_clause([_C|Rest]) ->
- discard_clause(Rest);
-discard_clause([]) -> % parse error
- [].
-
-
-print_data(Port) ->
- receive
- {Port, {data, Bytes}} ->
- io:put_chars(Bytes),
- print_data(Port);
- {Port, eof} ->
- Port ! {self(), close},
- receive
- {Port, closed} ->
- true
- end,
- receive
- {'EXIT', Port, _} ->
- ok
- after 1 -> % force context switch
- ok
- end
- end.
-
-maybe_atom_to_list(To_list) when is_list(To_list) ->
- To_list;
-maybe_atom_to_list(To_list) when is_atom(To_list)->
- atom_to_list(To_list).
-
-
-%% Configure and run all the Makefiles in the data dir of the suite
-%% in question
-make_non_erlang(DataDir, Variables) ->
- %% Make the stuff in all_SUITE_data if it exists
- AllDir = filename:join(DataDir,"../all_SUITE_data"),
- case filelib:is_dir(AllDir) of
- true ->
- make_non_erlang_do(AllDir,Variables);
- false ->
- ok
- end,
- make_non_erlang_do(DataDir, Variables).
-
-make_non_erlang_do(DataDir, Variables) ->
- try
- MakeCommand = proplists:get_value(make_command,Variables),
-
- FirstMakefile = filename:join(DataDir,"Makefile.first"),
- case filelib:is_regular(FirstMakefile) of
- true ->
- io:format("Making ~p",[FirstMakefile]),
- ok = ts_make:make(
- MakeCommand, DataDir, filename:basename(FirstMakefile));
- false ->
- ok
- end,
-
- MakefileSrc = filename:join(DataDir,"Makefile.src"),
- MakefileDest = filename:join(DataDir,"Makefile"),
- case filelib:is_regular(MakefileSrc) of
- true ->
- ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables),
- io:format("Making ~p",[MakefileDest]),
- ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir}
- | Variables]);
- false ->
- ok
- end
- after
- timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore
- end.
-
-b2s(Bin) ->
- unicode:characters_to_list(Bin,default_encoding()).
-
-default_encoding() ->
- try epp:default_encoding()
- catch error:undef -> latin1
- end.
diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl
deleted file mode 100644
index 0178f4d836..0000000000
--- a/lib/test_server/src/ts_make.erl
+++ /dev/null
@@ -1,114 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ts_make).
-
--export([make/1,make/3,unmake/1]).
-
--include("test_server.hrl").
-
-%% Functions to be called from make test cases.
-
-make(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- Makefile = proplists:get_value(makefile, Config),
- Make = proplists:get_value(make_command, Config),
- case make(Make, DataDir, Makefile) of
- ok -> ok;
- {error,Reason} -> exit({make_failed,Reason})
- end.
-
-unmake(Config) when is_list(Config) ->
- ok.
-
-%% Runs `make' in the given directory.
-%% Result: ok | {error, Reason}
-
-make(Make, Dir, Makefile) ->
- {RunFile, RunCmd, Script} = run_make_script(os:type(), Make, Dir, Makefile),
- case file:write_file(RunFile, Script) of
- ok ->
- Log = filename:join(Dir, "make.log"),
- file:delete(Log),
- Port = open_port({spawn, RunCmd}, [eof,stream,in,stderr_to_stdout]),
- case get_port_data(Port, [], false) of
- "*ok*" ++ _ -> ok;
- "*error*" ++ _ -> {error, make};
- Other ->{error,{make,Other}}
- end;
- Error -> Error
- end.
-
-get_port_data(Port, Last0, Complete0) ->
- receive
- {Port,{data,Bytes}} ->
- {Last, Complete} = update_last(Bytes, Last0, Complete0),
- get_port_data(Port, Last, Complete);
- {Port, eof} ->
- Result = update_last(eof, Last0, Complete0),
- unlink(Port),
- exit(Port, die),
- Result
- end.
-
-update_last([C|Rest], Line, true) ->
- try
- %% Utf-8 list to utf-8 binary
- %% (e.g. we assume utf-8 bytes from port)
- io:put_chars(list_to_binary(Line))
- catch
- error:badarg ->
- %% io:put_chars/1 badarged
- %% this likely means we had unicode code points
- %% in our bytes buffer (e.g warning from gcc with åäö)
- io:put_chars(unicode:characters_to_binary(Line))
- end,
- io:nl(),
- update_last([C|Rest], [], false);
-update_last([$\r|Rest], Result, Complete) ->
- update_last(Rest, Result, Complete);
-update_last([$\n|Rest], Result, _Complete) ->
- update_last(Rest, lists:reverse(Result), true);
-update_last([C|Rest], Result, Complete) ->
- update_last(Rest, [C|Result], Complete);
-update_last([], Result, Complete) ->
- {Result, Complete};
-update_last(eof, Result, _) ->
- unicode:characters_to_list(list_to_binary(Result)).
-
-run_make_script({win32, _}, Make, Dir, Makefile) ->
- {"run_make.bat",
- ".\\run_make",
- ["@echo off\r\n",
- "cd \"", filename:nativename(Dir), "\"\r\n",
- Make, " -f ", Makefile, " \r\n",
- "if errorlevel 1 echo *error*\r\n",
- "if not errorlevel 1 echo *ok*\r\n"]};
-run_make_script({unix, _}, Make, Dir, Makefile) ->
- {"run_make",
- "/bin/sh ./run_make",
- ["#!/bin/sh\n",
- "cd \"", Dir, "\"\n",
- Make, " -f ", Makefile, " 2>&1\n",
- "case $? in\n",
- " 0) echo '*ok*';;\n",
- " *) echo '*error*';;\n",
- "esac\n"]};
-run_make_script(_Other, _Make, _Dir, _Makefile) ->
- exit(dont_know_how_to_make_script_on_this_platform).
diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl
deleted file mode 100644
index 188094921d..0000000000
--- a/lib/test_server/src/ts_run.erl
+++ /dev/null
@@ -1,455 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%% Purpose : Supervises running of test cases.
-
--module(ts_run).
-
--export([run/4,ct_run_test/2]).
-
--define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60).
--define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15).
-
--include("ts.hrl").
-
--import(lists, [member/2,filter/2]).
-
--record(state,
- {file, % File given.
- mod, % Module to run.
- test_server_args, % Arguments to test server.
- command, % Command to run.
- test_dir, % Directory for test suite.
- makefiles, % List of all makefiles.
- makefile, % Current makefile.
- batch, % Are we running in batch mode?
- data_wc, % Wildcard for data dirs.
- topcase, % Top case specification.
- all % Set if we have all_SUITE_data
- }).
-
--define(tracefile,"traceinfo").
-
-%% Options is a slightly modified version of the options given to
-%% ts:run. Vars0 are from the variables file.
-run(File, Args0, Options, Vars0) ->
- Vars=
- case lists:keysearch(vars, 1, Options) of
- {value, {vars, Vars1}} ->
- Vars1++Vars0;
- _ ->
- Vars0
- end,
- {Batch,Runner} =
- case {member(interactive, Options), member(batch, Options)} of
- {false, true} ->
- {true, fun run_batch/3};
- _ ->
- {false, fun run_interactive/3}
- end,
- Hooks = [fun init_state/3,
- fun run_preinits/3,
- fun make_command/3,
- Runner],
- Args = make_common_test_args(Args0,Options,Vars),
- St = #state{file=File,test_server_args=Args,batch=Batch},
- R = execute(Hooks, Vars, [], St),
- case R of
- {ok,_,_,_} -> ok;
- Error -> Error
- end.
-
-execute([Hook|Rest], Vars0, Spec0, St0) ->
- case Hook(Vars0, Spec0, St0) of
- ok ->
- execute(Rest, Vars0, Spec0, St0);
- {ok, Vars, Spec, St} ->
- execute(Rest, Vars, Spec, St);
- Error ->
- Error
- end;
-execute([], Vars, Spec, St) ->
- {ok, Vars, Spec, St}.
-
-%% Wrapper to run tests using ct:run_test/1 and handle any errors.
-
-ct_run_test(Dir, CommonTestArgs) ->
- try
- ok = file:set_cwd(Dir),
- case ct:run_test(CommonTestArgs) of
- {_,_,_} ->
- ok;
- {error,Error} ->
- io:format("ERROR: ~P\n", [Error,20]);
- Other ->
- io:format("~P\n", [Other,20])
- end
- catch
- _:Crash ->
- io:format("CRASH: ~P\n", [Crash,20])
- end.
-
-%%
-%% Deletes File from Files when File is on the form .../<SUITE>_data/<file>
-%% when all of <SUITE> has been skipped in Spec, i.e. there
-%% exists a {skip, {<SUITE>, _}} tuple in Spec.
-%%
-del_skipped_suite_data_dir(Files, Spec) ->
- SkipDirNames = lists:foldl(fun ({skip, {SS, _C}}, SSs) ->
- [atom_to_list(SS) ++ "_data" | SSs];
- (_, SSs) ->
- SSs
- end,
- [],
- Spec),
- filter(fun (File) ->
- not member(filename:basename(filename:dirname(File)),
- SkipDirNames)
- end,
- Files).
-
-%% Initialize our internal state.
-
-init_state(Vars, [], St0) ->
- {FileBase,Wc0,Mod} =
- case St0#state.file of
- {Fil,Mod0} -> {Fil, atom_to_list(Mod0) ++ "*_data",Mod0};
- Fil -> {Fil,"*_SUITE_data",[]}
- end,
- {ok,Cwd} = file:get_cwd(),
- TestDir = filename:join(filename:dirname(Cwd), FileBase++"_test"),
- case filelib:is_dir(TestDir) of
- true ->
- Wc = filename:join(TestDir, Wc0),
- {ok,Vars,[],St0#state{file=FileBase,mod=Mod,
- test_dir=TestDir,data_wc=Wc}};
- false ->
- {error,{no_test_directory,TestDir}}
- end.
-
-%% Run any "Makefile.first" files first.
-%% XXX We should fake a failing test case if the make fails.
-
-run_preinits(Vars, Spec, St) ->
- Wc = filename:join(St#state.data_wc, "Makefile.first"),
- run_pre_makefiles(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec),
- Vars, Spec, St),
- {ok,Vars,Spec,St}.
-
-run_pre_makefiles([Makefile|Ms], Vars0, Spec0, St0) ->
- Hooks = [fun run_pre_makefile/3],
- case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of
- {error,_Reason}=Error -> Error;
- {ok,Vars,Spec,St} -> run_pre_makefiles(Ms, Vars, Spec, St)
- end;
-run_pre_makefiles([], Vars, Spec, St) -> {ok,Vars,Spec,St}.
-
-run_pre_makefile(Vars, Spec, St) ->
- Makefile = St#state.makefile,
- Shortname = filename:basename(Makefile),
- DataDir = filename:dirname(Makefile),
- Make = ts_lib:var(make_command, Vars),
- case ts_make:make(Make,DataDir, Shortname) of
- ok -> {ok,Vars,Spec,St};
- {error,_Reason}=Error -> Error
- end.
-
-get_config_files() ->
- TSConfig = "ts.config",
- [TSConfig | case os:type() of
- {unix,_} -> ["ts.unix.config"];
- {win32,_} -> ["ts.win32.config"];
- _ -> []
- end].
-
-%% Makes the command to start up the Erlang node to run the tests.
-
-backslashify([$\\, $" | T]) ->
- [$\\, $" | backslashify(T)];
-backslashify([$" | T]) ->
- [$\\, $" | backslashify(T)];
-backslashify([H | T]) ->
- [H | backslashify(T)];
-backslashify([]) ->
- [].
-
-make_command(Vars, Spec, State) ->
- {ok,Cwd} = file:get_cwd(),
- TestDir = State#state.test_dir,
- TestPath = filename:nativename(TestDir),
- Erl = case os:getenv("TS_RUN_VALGRIND") of
- false ->
- atom_to_list(lib:progname());
- _ ->
- case State#state.file of
- Dir when is_list(Dir) ->
- os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-");
- _ ->
- ok
- end,
- "cerl -valgrind" ++
- case erlang:system_info(smp_support) of
- true -> " -smp";
- false -> ""
- end
- end,
- Naming =
- case ts_lib:var(longnames, Vars) of
- true ->
- " -name ";
- false ->
- " -sname "
- end,
- ExtraArgs =
- case lists:keysearch(erl_start_args,1,Vars) of
- {value,{erl_start_args,Args}} -> Args;
- false -> ""
- end,
- CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"),
- case filelib:is_file(CrashFile) of
- true ->
- io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]),
- file:delete(CrashFile);
- false ->
- ok
- end,
-
- %% If Common Test specific variables are needed, add them here
- %% on form: "{key1,value1}" "{key2,value2}" ...
- NetDir = ts_lib:var(ts_net_dir, Vars),
- TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ],
-
- %% NOTE: Do not use ' in these commands as it wont work on windows
- Cmd = [Erl, Naming, "test_server"
- " -rsh ", ts_lib:var(rsh_name, Vars),
- " -env PATH \"",
- backslashify(lists:flatten([TestPath, path_separator(),
- remove_path_spaces()])),
- "\"",
- " -env ERL_CRASH_DUMP ", CrashFile,
- %% uncomment the line below to disable exception formatting
- %% " -test_server_format_exception false",
- " -boot start_sasl -sasl errlog_type error",
- " -pz \"",Cwd,"\"",
- " -ct_test_vars ",TestVars,
- " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ",
- backslashify(lists:flatten(State#state.test_server_args)),")\""
- " ",
- ExtraArgs],
- {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}.
-
-
-run_batch(Vars, _Spec, State) ->
- process_flag(trap_exit, true),
- Command = State#state.command ++ " -noinput -s erlang halt",
- ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]),
- io:format(user, "Command: ~ts~n",[Command]),
- Port = open_port({spawn, Command}, [stream, in, eof]),
- Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of
- false -> 1;
- _ -> 100
- end,
- tricky_print_data(Port, Timeout).
-
-tricky_print_data(Port, Timeout) ->
- receive
- {Port, {data, Bytes}} ->
- io:put_chars(Bytes),
- tricky_print_data(Port, Timeout);
- {Port, eof} ->
- Port ! {self(), close},
- receive
- {Port, closed} ->
- true
- end,
- receive
- {'EXIT', Port, _} ->
- ok
- after 1 -> % force context switch
- ok
- end
- after Timeout ->
- case erl_epmd:names() of
- {ok,Names} ->
- case is_testnode_dead(Names) of
- true ->
- io:put_chars("WARNING: No EOF, but "
- "test_server node is down!\n");
- false ->
- tricky_print_data(Port, Timeout)
- end;
- _ ->
- tricky_print_data(Port, Timeout)
- end
- end.
-
-is_testnode_dead([]) -> true;
-is_testnode_dead([{"test_server",_}|_]) -> false;
-is_testnode_dead([_|T]) -> is_testnode_dead(T).
-
-run_interactive(Vars, _Spec, State) ->
- Command = State#state.command,
- ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]),
- case ts_lib:var(os, Vars) of
- "Windows 95" ->
- %% Windows 95 strikes again! We must redirect standard
- %% input and output for the `start' command, to force
- %% standard input and output to the Erlang shell to be
- %% connected to the newly started console.
- %% Without these redirections, the Erlang shell would be
- %% connected to the pipes provided by the port program
- %% and there would be an inactive console window.
- os:cmd("start < nul > nul w" ++ Command),
- ok;
- "Windows 98" ->
- os:cmd("start < nul > nul w" ++ Command),
- ok;
- "Windows"++_ ->
- os:cmd("start w" ++ Command),
- ok;
- _Other ->
- %% Assuming ts and controller always run on solaris
- start_xterm(Command)
- end.
-
-start_xterm(Command) ->
- case os:find_executable("xterm") of
- false ->
- io:format("The `xterm' program was not found.\n"),
- {error, no_xterm};
- _Xterm ->
- case os:getenv("DISPLAY") of
- false ->
- io:format("DISPLAY is not set.\n"),
- {error, display_not_set};
- Display ->
- io:format("Starting xterm (DISPLAY=~s)...\n",
- [Display]),
- os:cmd("xterm -sl 10000 -e " ++ Command ++ "&"),
- ok
- end
- end.
-
-path_separator() ->
- case os:type() of
- {win32, _} -> ";";
- {unix, _} -> ":"
- end.
-
-
-make_common_test_args(Args0, Options0, _Vars) ->
- Trace =
- case lists:keysearch(trace,1,Options0) of
- {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) ->
- ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])),
- [{ct_trace,?tracefile}];
- {value,{trace,TIFile}} when is_atom(TIFile) ->
- [{ct_trace,atom_to_list(TIFile)}];
- {value,{trace,TIFile}} ->
- [{ct_trace,TIFile}];
- false ->
- []
- end,
- Cover =
- case lists:keysearch(cover,1,Options0) of
- {value,{cover, App, none, _Analyse}} ->
- io:format("No cover file found for ~p~n",[App]),
- [];
- {value,{cover,_App,File,_Analyse}} ->
- [{cover,to_list(File)},{cover_stop,false}];
- false ->
- []
- end,
-
- Logdir = case lists:keysearch(logdir, 1, Options0) of
- {value,{logdir, _}} ->
- [];
- false ->
- [{logdir,"../test_server"}]
- end,
-
- TimeTrap = [{scale_timetraps, true}],
-
- {ConfigPath,
- Options} = case {os:getenv("TEST_CONFIG_PATH"),
- lists:keysearch(config, 1, Options0)} of
- {_,{value, {config, Path}}} ->
- {Path,lists:keydelete(config, 1, Options0)};
- {false,false} ->
- {"../test_server",Options0};
- {Path,_} ->
- {Path,Options0}
- end,
- ConfigFiles = [{config,[filename:join(ConfigPath,File)
- || File <- get_config_files()]}],
- io_lib:format("~100000p",[[{abort_if_missing_suites,true} |
- Args0++Trace++Cover++Logdir++
- ConfigFiles++Options++TimeTrap]]).
-
-to_list(X) when is_atom(X) ->
- atom_to_list(X);
-to_list(X) when is_list(X) ->
- X.
-
-%%
-%% Paths and spaces handling for w2k and XP
-%%
-remove_path_spaces() ->
- Path = os:getenv("PATH"),
- case os:type() of
- {win32,nt} ->
- remove_path_spaces(Path);
- _ ->
- Path
- end.
-
-remove_path_spaces(Path) ->
- SPath = split_path(Path),
- [NSHead|NSTail] = lists:map(fun(X) -> filename:nativename(
- filename:join(
- translate_path(split_one(X))))
- end,
- SPath),
- NSHead ++ lists:flatten([[$;|X] || X <- NSTail]).
-
-translate_path(PList) ->
- %io:format("translate_path([~p|~p]~n",[Base,PList]),
- translate_path(PList,[]).
-
-
-translate_path([],_) ->
- [];
-translate_path([PC | T],BaseList) ->
- FullPath = filename:nativename(filename:join(BaseList ++ [PC])),
- NewPC = case catch file:altname(FullPath) of
- {ok,X} ->
- X;
- _ ->
- PC
- end,
- %io:format("NewPC:~s, DirList:~p~n",[NewPC,DirList]),
- NewBase = BaseList ++ [NewPC],
- [NewPC | translate_path(T,NewBase)].
-
-split_one(Path) ->
- filename:split(Path).
-
-split_path(Path) ->
- string:tokens(Path,";").