aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test/test_server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/common_test/test_server')
-rw-r--r--lib/common_test/test_server/Makefile96
-rw-r--r--lib/common_test/test_server/conf_vars.in25
-rw-r--r--lib/common_test/test_server/configure.in509
-rw-r--r--lib/common_test/test_server/cross.cover20
-rw-r--r--lib/common_test/test_server/ts.config46
-rw-r--r--lib/common_test/test_server/ts.erl1019
-rw-r--r--lib/common_test/test_server/ts.hrl38
-rw-r--r--lib/common_test/test_server/ts.unix.config6
-rw-r--r--lib/common_test/test_server/ts.win32.config8
-rw-r--r--lib/common_test/test_server/ts_autoconf_win32.erl256
-rw-r--r--lib/common_test/test_server/ts_benchmark.erl87
-rw-r--r--lib/common_test/test_server/ts_erl_config.erl403
-rw-r--r--lib/common_test/test_server/ts_install.erl465
-rw-r--r--lib/common_test/test_server/ts_install_cth.erl270
-rw-r--r--lib/common_test/test_server/ts_lib.erl372
-rw-r--r--lib/common_test/test_server/ts_make.erl114
-rw-r--r--lib/common_test/test_server/ts_run.erl455
17 files changed, 4189 insertions, 0 deletions
diff --git a/lib/common_test/test_server/Makefile b/lib/common_test/test_server/Makefile
new file mode 100644
index 0000000000..0adf64b837
--- /dev/null
+++ b/lib/common_test/test_server/Makefile
@@ -0,0 +1,96 @@
+#
+# %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
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+EBIN=.
+
+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)/%)
+
+TS_ERL_FILES = $(TS_MODULES:=.erl)
+TS_HRL_FILES = ts.hrl
+AUTOCONF_FILES = configure.in conf_vars.in
+PROGRAMS = configure config.sub config.guess install-sh
+CONFIG = ts.config ts.unix.config ts.win32.config
+
+TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += -I../include -Werror
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+tests debug opt: $(TS_TARGETS)
+
+clean:
+ rm -f $(TS_TARGET_FILES)
+ rm -f core
+
+docs:
+
+configure: configure.in
+ autoconf configure.in > configure
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_tests_spec: opt
+ $(INSTALL_DIR) "$(RELEASE_PATH)/test_server"
+ $(INSTALL_DATA) $(TS_ERL_FILES) $(TS_HRL_FILES) \
+ $(TS_TARGET_FILES) \
+ $(AUTOCONF_FILES) $(CONFIG) \
+ "$(RELEASE_PATH)/test_server"
+ $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server"
+
+release_docs_spec:
+
diff --git a/lib/common_test/test_server/conf_vars.in b/lib/common_test/test_server/conf_vars.in
new file mode 100644
index 0000000000..7c55d7b9ed
--- /dev/null
+++ b/lib/common_test/test_server/conf_vars.in
@@ -0,0 +1,25 @@
+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/common_test/test_server/configure.in b/lib/common_test/test_server/configure.in
new file mode 100644
index 0000000000..001de72a1e
--- /dev/null
+++ b/lib/common_test/test_server/configure.in
@@ -0,0 +1,509 @@
+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/common_test/test_server/cross.cover b/lib/common_test/test_server/cross.cover
new file mode 100644
index 0000000000..07bf0bed5c
--- /dev/null
+++ b/lib/common_test/test_server/cross.cover
@@ -0,0 +1,20 @@
+%%% 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/common_test/test_server/ts.config b/lib/common_test/test_server/ts.config
new file mode 100644
index 0000000000..cf3d269616
--- /dev/null
+++ b/lib/common_test/test_server/ts.config
@@ -0,0 +1,46 @@
+%% -*- 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/common_test/test_server/ts.erl b/lib/common_test/test_server/ts.erl
new file mode 100644
index 0000000000..8bbdc8f8cf
--- /dev/null
+++ b/lib/common_test/test_server/ts.erl
@@ -0,0 +1,1019 @@
+%%
+%% %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/common_test/test_server/ts.hrl b/lib/common_test/test_server/ts.hrl
new file mode 100644
index 0000000000..4c940fdc4f
--- /dev/null
+++ b/lib/common_test/test_server/ts.hrl
@@ -0,0 +1,38 @@
+%%
+%% %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/common_test/test_server/ts.unix.config b/lib/common_test/test_server/ts.unix.config
new file mode 100644
index 0000000000..1ba5d9033e
--- /dev/null
+++ b/lib/common_test/test_server/ts.unix.config
@@ -0,0 +1,6 @@
+%% -*- 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/common_test/test_server/ts.win32.config b/lib/common_test/test_server/ts.win32.config
new file mode 100644
index 0000000000..cae587bea8
--- /dev/null
+++ b/lib/common_test/test_server/ts.win32.config
@@ -0,0 +1,8 @@
+%% -*- 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/common_test/test_server/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl
new file mode 100644
index 0000000000..288305b406
--- /dev/null
+++ b/lib/common_test/test_server/ts_autoconf_win32.erl
@@ -0,0 +1,256 @@
+%%
+%% %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/common_test/test_server/ts_benchmark.erl b/lib/common_test/test_server/ts_benchmark.erl
new file mode 100644
index 0000000000..3e55edefb0
--- /dev/null
+++ b/lib/common_test/test_server/ts_benchmark.erl
@@ -0,0 +1,87 @@
+%%
+%% %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/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl
new file mode 100644
index 0000000000..ab7363c106
--- /dev/null
+++ b/lib/common_test/test_server/ts_erl_config.erl
@@ -0,0 +1,403 @@
+%%
+%% %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/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl
new file mode 100644
index 0000000000..600a576820
--- /dev/null
+++ b/lib/common_test/test_server/ts_install.erl
@@ -0,0 +1,465 @@
+%%
+%% %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/common_test/test_server/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl
new file mode 100644
index 0000000000..0462e62611
--- /dev/null
+++ b/lib/common_test/test_server/ts_install_cth.erl
@@ -0,0 +1,270 @@
+%%
+%% %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_init_per_testcase/4]).
+-export([pre_end_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}.
+
+-spec post_init_per_testcase(TC :: atom(),
+ Config :: config(),
+ Return :: term(),
+ State :: #state{}) ->
+ {ok | skip_or_fail(), NewState :: #state{}}.
+post_init_per_testcase(_TC,_Config,Return,State) ->
+ {Return, State}.
+
+%% @doc Called after each test case.
+-spec pre_end_per_testcase(TC :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
+ {config() | skip_or_fail(), NewState :: #state{}}.
+pre_end_per_testcase(_TC,Config,State) ->
+ {Config, State}.
+
+-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/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl
new file mode 100644
index 0000000000..7c3f450194
--- /dev/null
+++ b/lib/common_test/test_server/ts_lib.erl
@@ -0,0 +1,372 @@
+%%
+%% %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/common_test/test_server/ts_make.erl b/lib/common_test/test_server/ts_make.erl
new file mode 100644
index 0000000000..921edb264a
--- /dev/null
+++ b/lib/common_test/test_server/ts_make.erl
@@ -0,0 +1,114 @@
+%%
+%% %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_lib("common_test/include/ct.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/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl
new file mode 100644
index 0000000000..188094921d
--- /dev/null
+++ b/lib/common_test/test_server/ts_run.erl
@@ -0,0 +1,455 @@
+%%
+%% %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,";").
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 18:38:12 +0000