aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/erl_docgen/priv/xsl/db_eix.xsl206
-rw-r--r--lib/erl_docgen/priv/xsl/db_html.xsl2
-rw-r--r--lib/erl_interface/src/decode/decode_skip.c1
-rw-r--r--lib/erl_interface/test/Makefile78
-rw-r--r--lib/erl_interface/test/Makefile.src71
-rw-r--r--lib/erl_interface/test/README28
-rw-r--r--lib/erl_interface/test/all_SUITE_data/Makefile.first20
-rw-r--r--lib/erl_interface/test/all_SUITE_data/Makefile.src45
-rw-r--r--lib/erl_interface/test/all_SUITE_data/ei_runner.c400
-rw-r--r--lib/erl_interface/test/all_SUITE_data/ei_runner.h61
-rw-r--r--lib/erl_interface/test/all_SUITE_data/gccifier.c317
-rwxr-xr-xlib/erl_interface/test/all_SUITE_data/gccifier.sh26
-rw-r--r--lib/erl_interface/test/all_SUITE_data/init_tc.erl101
-rw-r--r--lib/erl_interface/test/all_SUITE_data/reclaim.h151
-rw-r--r--lib/erl_interface/test/all_SUITE_data/runner.c457
-rw-r--r--lib/erl_interface/test/all_SUITE_data/runner.h50
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE.erl151
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src45
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c224
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c234
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE.erl218
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src46
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c289
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/einode.c158
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE.erl300
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c548
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE.erl290
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c229
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE.erl315
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c466
-rw-r--r--lib/erl_interface/test/ei_format_SUITE.erl161
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c184
-rw-r--r--lib/erl_interface/test/ei_print_SUITE.erl142
-rw-r--r--lib/erl_interface/test/ei_print_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_print_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c175
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE.erl666
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src41
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c767
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE.erl134
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src41
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c202
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE.erl1136
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src50
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c166
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c1511
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c129
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE.erl81
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE_data/Makefile.src41
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c485
-rw-r--r--lib/erl_interface/test/erl_format_SUITE.erl136
-rw-r--r--lib/erl_interface/test/erl_format_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_format_SUITE_data/Makefile.src43
-rw-r--r--lib/erl_interface/test/erl_format_SUITE_data/format_test.c132
-rw-r--r--lib/erl_interface/test/erl_interface.dynspec18
-rw-r--r--lib/erl_interface/test/erl_interface.spec2
-rw-r--r--lib/erl_interface/test/erl_interface.spec.vxworks5
-rw-r--r--lib/erl_interface/test/erl_match_SUITE.erl288
-rw-r--r--lib/erl_interface/test/erl_match_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_match_SUITE_data/Makefile.src42
-rw-r--r--lib/erl_interface/test/erl_match_SUITE_data/match_test.c113
-rw-r--r--lib/erl_interface/test/port_call_SUITE.erl106
-rw-r--r--lib/erl_interface/test/port_call_SUITE_data/Makefile.src39
-rw-r--r--lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c103
-rw-r--r--lib/erl_interface/test/runner.erl130
-rw-r--r--lib/stdlib/src/otp_internal.erl4
80 files changed, 13282 insertions, 1 deletions
diff --git a/lib/erl_docgen/priv/xsl/db_eix.xsl b/lib/erl_docgen/priv/xsl/db_eix.xsl
new file mode 100644
index 0000000000..929272256a
--- /dev/null
+++ b/lib/erl_docgen/priv/xsl/db_eix.xsl
@@ -0,0 +1,206 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!--
+ #
+ # %CopyrightBegin%
+ #
+ # Copyright Ericsson AB 2009. All Rights Reserved.
+ #
+ # The contents of this file are subject to the Erlang Public License,
+ # Version 1.1, (the "License"); you may not use this file except in
+ # compliance with the License. You should have received a copy of the
+ # Erlang Public License along with this software. If not, it can be
+ # retrieved online at http://www.erlang.org/.
+ #
+ # Software distributed under the License is distributed on an "AS IS"
+ # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ # the License for the specific language governing rights and limitations
+ # under the License.
+ #
+ # %CopyrightEnd%
+
+ -->
+
+<xsl:stylesheet version="1.0"
+ xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+ xmlns:fn="http://www.w3.org/2005/02/xpath-functions">
+
+ <xsl:output method="text" encoding="UTF-8" indent="no"/>
+
+ <!-- Book -->
+ <xsl:template match="/book">
+ <xsl:text>%% &#10;%% Search data file for </xsl:text><xsl:value-of select="$appname"/><xsl:text> </xsl:text><xsl:value-of select="$appver"/>
+ <xsl:text>&#10;%% generated </xsl:text><xsl:value-of select="$gendate"/><xsl:text>&#10;%% &#10;</xsl:text>
+ <xsl:apply-templates select="applications"/>
+ <xsl:text>{notused, application, ["</xsl:text><xsl:value-of select="$appname"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+ <!-- Applications -->
+ <xsl:template match="applications">
+ <xsl:apply-templates name="application"/>
+ </xsl:template>
+
+ <!-- Reference Manual -->
+
+ <!-- Application -->
+ <xsl:template match="application">
+ <xsl:apply-templates select="erlref|cref|comref|fileref|appref"/>
+ </xsl:template>
+
+ <!-- Erlref -->
+ <xsl:template match="erlref">
+ <xsl:text>{"</xsl:text><xsl:value-of select="module"/><xsl:text>.html", {function, {"</xsl:text><xsl:value-of select="$appname"/>
+ <xsl:text>", "</xsl:text><xsl:value-of select="module"/><xsl:text>"}},&#10;[&#10;</xsl:text>
+ <xsl:apply-templates select="funcs">
+ <xsl:with-param name="mod" select="module"/>
+ </xsl:apply-templates>
+ <xsl:text>]}.&#10;</xsl:text>
+ <xsl:text>{"</xsl:text><xsl:value-of select="module"/><xsl:text>.html", {module, "</xsl:text>
+ <xsl:value-of select="$appname"/><xsl:text>"}, ["</xsl:text><xsl:value-of select="module"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+ <!-- Cref -->
+ <xsl:template match="cref">
+ <xsl:text>{"</xsl:text><xsl:value-of select="lib"/><xsl:text>.html", {function, {"</xsl:text><xsl:value-of select="$appname"/>
+ <xsl:text>", "</xsl:text><xsl:value-of select="lib"/><xsl:text>"}}, [&#10;</xsl:text>
+ <xsl:apply-templates select="funcs">
+ <xsl:with-param name="mod" select="lib"/>
+ </xsl:apply-templates>
+ <xsl:text>]}.&#10;</xsl:text>
+ <xsl:text>{"</xsl:text><xsl:value-of select="lib"/><xsl:text>.html", {clib, "</xsl:text>
+ <xsl:value-of select="$appname"/><xsl:text>"}, ["</xsl:text><xsl:value-of select="lib"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+ <!-- Comref -->
+ <xsl:template match="comref">
+ <xsl:text>{"</xsl:text><xsl:value-of select="com"/><xsl:text>.html", {command, "</xsl:text>
+ <xsl:value-of select="$appname"/><xsl:text>"}, ["</xsl:text><xsl:value-of select="com"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+ <!-- Fileref -->
+ <xsl:template match="fileref">
+ <xsl:text>{"</xsl:text><xsl:value-of select="file"/><xsl:text>.html", {file, "</xsl:text>
+ <xsl:value-of select="$appname"/><xsl:text>"}, ["</xsl:text><xsl:value-of select="file"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+ <!-- Appref -->
+ <xsl:template match="appref">
+ <xsl:text>{"</xsl:text><xsl:value-of select="app"/><xsl:text>_app.html", {app, "</xsl:text>
+ <xsl:value-of select="$appname"/><xsl:text>"}, ["</xsl:text><xsl:value-of select="app"/><xsl:text>"]}.&#10;</xsl:text>
+ </xsl:template>
+
+
+ <!-- Funcs -->
+ <xsl:template match="funcs">
+ <xsl:param name="mod"/>
+ <xsl:variable name="lastfuncsblock">
+ <xsl:value-of select="position() = last()"/>
+ </xsl:variable>
+ <xsl:apply-templates select="func/name">
+ <xsl:with-param name="mod" select="$mod"/>
+ <xsl:with-param name="lastfuncsblock" select="$lastfuncsblock"/>
+ </xsl:apply-templates>
+ </xsl:template>
+
+
+
+
+ <xsl:template match="name">
+ <xsl:param name="mod"/>
+ <xsl:param name="lastfuncsblock"/>
+
+ <xsl:variable name="tmpstring">
+ <xsl:value-of select="substring-before(substring-after(., '('), '->')"/>
+ </xsl:variable>
+ <xsl:variable name="ustring">
+ <xsl:choose>
+ <xsl:when test="string-length($tmpstring) > 0">
+ <xsl:call-template name="remove-paren">
+ <xsl:with-param name="string" select="$tmpstring"/>
+ </xsl:call-template>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:call-template name="remove-paren">
+ <xsl:with-param name="string" select="substring-after(., '(')"/>
+ </xsl:call-template>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:variable>
+ <xsl:variable name="arity">
+ <xsl:call-template name="calc-arity">
+ <xsl:with-param name="string" select="substring-before($ustring, ')')"/>
+ <xsl:with-param name="no-of-pars" select="0"/>
+ </xsl:call-template>
+ </xsl:variable>
+ <xsl:variable name="fname">
+ <xsl:choose>
+ <xsl:when test="ancestor::cref">
+ <xsl:value-of select="substring-before(nametext, '(')"/>
+ </xsl:when>
+ <xsl:when test="ancestor::erlref">
+ <xsl:value-of select="substring-before(., '(')"/>
+ </xsl:when>
+ </xsl:choose>
+ </xsl:variable>
+ <xsl:text> {"</xsl:text><xsl:value-of select="$fname"/>
+ <xsl:text>", "</xsl:text><xsl:value-of select="$fname"/>
+ <xsl:text>(</xsl:text><xsl:value-of select="normalize-space($tmpstring)"/>
+ <xsl:text>", "</xsl:text><xsl:value-of select="$fname"/>
+ <xsl:text>-</xsl:text><xsl:value-of select="$arity"/><xsl:text>"}</xsl:text>
+
+ <xsl:choose>
+ <xsl:when test="($lastfuncsblock = 'true') and (position() = last())">
+ <xsl:text>&#10;</xsl:text>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:text>,&#10;</xsl:text>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
+ <!-- Special templates to calculate the arity of functions -->
+ <xsl:template name="calc-arity">
+ <xsl:param name="string"/>
+ <xsl:param name="no-of-pars"/>
+ <xsl:variable name="length">
+ <xsl:value-of select="string-length($string)"/>
+ </xsl:variable>
+ <xsl:choose>
+ <xsl:when test="$length > 0">
+ <xsl:call-template name="calc-arity">
+ <xsl:with-param name="string" select="substring-after($string, ',')"/>
+ <xsl:with-param name="no-of-pars" select="$no-of-pars+1"/>
+ </xsl:call-template>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:value-of select="$no-of-pars"/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
+ <xsl:template name="remove-paren">
+ <xsl:param name="string"/>
+ <xsl:variable name="bstring">
+ <xsl:value-of select="substring-before($string, '(')"/>
+ </xsl:variable>
+ <xsl:choose>
+ <xsl:when test="string-length($bstring) > 0">
+ <xsl:variable name="astring">
+ <xsl:value-of select="substring-after($string, ')')"/>
+ </xsl:variable>
+ <xsl:variable name="retstring">
+ <xsl:call-template name="remove-paren">
+ <xsl:with-param name="string" select="$astring"/>
+ </xsl:call-template>
+ </xsl:variable>
+ <xsl:value-of select="concat($bstring, $retstring)"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:value-of select="$string"/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
+ <!-- default content handling -->
+ <xsl:template match="text()"/>
+
+</xsl:stylesheet>
diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl
index 3e6f762870..984655fc26 100644
--- a/lib/erl_docgen/priv/xsl/db_html.xsl
+++ b/lib/erl_docgen/priv/xsl/db_html.xsl
@@ -61,7 +61,7 @@
<xsl:value-of select="$copyright"/>
<xsl:value-of select="/book/header/copyright/year[1]"/>
<xsl:text>-</xsl:text>
- <xsl:value-of select="substring-after(substring-after($gendate, ' '), ' ')"/>
+ <xsl:value-of select="substring-after(normalize-space(substring-after($gendate, ' ')), ' ')"/>
<xsl:text> </xsl:text>
<xsl:value-of select="/book/header/copyright/holder"/>
</p>
diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c
index 2fc68a3601..316b5bee98 100644
--- a/lib/erl_interface/src/decode/decode_skip.c
+++ b/lib/erl_interface/src/decode/decode_skip.c
@@ -80,6 +80,7 @@ int ei_skip_term(const char* buf, int* index)
if (ei_decode_double(buf, index, NULL) < 0) return -1;
break;
case ERL_FUN_EXT:
+ case ERL_NEW_FUN_EXT:
if (ei_decode_fun(buf, index, NULL) < 0) return -1;
break;
default:
diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile
new file mode 100644
index 0000000000..b7a1a4e4d8
--- /dev/null
+++ b/lib/erl_interface/test/Makefile
@@ -0,0 +1,78 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+ ei_accept_SUITE \
+ ei_connect_SUITE \
+ ei_decode_SUITE \
+ ei_decode_encode_SUITE \
+ ei_encode_SUITE \
+ ei_format_SUITE \
+ ei_print_SUITE \
+ ei_tmo_SUITE \
+ erl_connect_SUITE \
+ erl_eterm_SUITE \
+ erl_ext_SUITE \
+ erl_format_SUITE \
+ erl_match_SUITE \
+ port_call_SUITE \
+ runner
+
+SPEC_FILES = \
+ erl_interface.spec \
+ erl_interface.dynspec \
+ erl_interface.spec.vxworks
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/erl_interface_test
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+tests debug opt:
+
+clean:
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec:
+
+release_tests_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DATA) $(SPEC_FILES) $(ERL_FILES) $(RELSYSDIR)
+ chmod -f -R u+w $(RELSYSDIR)
+ @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+
+release_docs_spec:
diff --git a/lib/erl_interface/test/Makefile.src b/lib/erl_interface/test/Makefile.src
new file mode 100644
index 0000000000..9c620bb8d9
--- /dev/null
+++ b/lib/erl_interface/test/Makefile.src
@@ -0,0 +1,71 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = $(LIBERL) $(LIBEI)
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../common
+
+ETERM_OBJS = eterm_test@obj@ eterm_test_decl@obj@ runner@obj@
+EXT_OBJS = ext_test@obj@ ext_test_decl@obj@ runner@obj@
+FORMAT_OBJS = format_test@obj@ format_test_decl@obj@ runner@obj@
+EI_FORMAT_OBJS = ei_format_test@obj@ ei_format_test_decl@obj@ ei_runner@obj@
+EI_PRINT_OBJS = ei_print_test@obj@ ei_print_test_decl@obj@ ei_runner@obj@
+EI_CONNECT_OBJS = ei_connect_test@obj@ ei_connect_test_decl@obj@ ei_runner@obj@
+EI_ACCEPT_OBJS = ei_accept_test@obj@ ei_accept_test_decl@obj@ ei_runner@obj@
+MATCH_OBJS = match_test@obj@ match_test_decl@obj@ runner@obj@
+
+PROGS = eterm_test@exe@ format_test@exe@ print_term@exe@ match_test@exe@ ei_format_test@exe@ ei_print_test@exe@ ei_connect_test@exe@ ei_accept_test@exe@
+
+
+all: $(PROGS)
+
+eterm_test@exe@: $(ETERM_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o eterm_test $(ETERM_OBJS) $(LIBFLAGS)
+
+ext_test@exe@: $(EXT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o ext_test $(EXT_OBJS) $(LIBFLAGS)
+
+format_test@exe@: $(FORMAT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o format_test $(FORMAT_OBJS) $(LIBFLAGS)
+
+ei_format_test@exe@: $(EI_FORMAT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o ei_format_test $(EI_FORMAT_OBJS) $(LIBFLAGS)
+
+ei_print_test@exe@: $(EI_PRINT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o ei_print_test $(EI_PRINT_OBJS) $(LIBFLAGS)
+
+ei_connect_test@exe@: $(EI_CONNECT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o ei_connect_test $(EI_CONNECT_OBJS) $(LIBFLAGS)
+
+ei_accept_test@exe@: $(EI_ACCEPT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o ei_accept_test $(EI_ACCEPT_OBJS) $(LIBFLAGS)
+
+match_test@exe@: $(MATCH_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o match_test $(MATCH_OBJS) $(LIBFLGAS)
+
+print_term@exe@: print_term@obj@ $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o print_term print_term@obj@ $(LIBFLGAS)
diff --git a/lib/erl_interface/test/README b/lib/erl_interface/test/README
new file mode 100644
index 0000000000..e1af025ca3
--- /dev/null
+++ b/lib/erl_interface/test/README
@@ -0,0 +1,28 @@
+
+One way to create a new suite, copy an old one
+that is similar to a new one
+
+ % setenv SIMILAR ei_xyz
+ % setenv NEW ei_abc
+
+ % ct mkdir ${NEW}_SUITE_data
+ % ct mkelem ${NEW}_SUITE.erl
+ % cp ${SIMILAR}_SUITE.erl ${NEW}_SUITE.erl
+ % cp ${SIMILAR}_SUITE_data/* ${NEW}_SUITE_data/
+ % chmod ug+rw ${NEW}_SUITE_data/*
+ % mv ${NEW}_SUITE_data/${SIMILAR}_test.c ${NEW}_SUITE_data/${NEW}_test.c
+ % ct mkelem ${NEW}_SUITE_data/*
+
+Now edit "${NEW}_SUITE.erl" and the files in "${NEW}_SUITE_data/".
+
+To use a test suite you build it and put the result outside
+ClearCase. Then you create soft links to the ClearCase elements.
+
+ % setenv SRC /clearcase/otp/erts/lib/erl_interface/test
+ % setenv DST /ldisk/test
+ % cd $SRC
+ % clearmake -V release TESTROOT=$DST
+ % foreach f (`find . -type f`)
+ foreach> \rm -f /ldisk/test/erl_interface_test/$f
+ foreach> ln -s $SRC/$f $DST/erl_interface_test/$f
+ foreach> end
diff --git a/lib/erl_interface/test/all_SUITE_data/Makefile.first b/lib/erl_interface/test/all_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..b9ce689057
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/Makefile.first
@@ -0,0 +1,20 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+all:
+ erlc -W init_tc.erl
diff --git a/lib/erl_interface/test/all_SUITE_data/Makefile.src b/lib/erl_interface/test/all_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..9be2360656
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/Makefile.src
@@ -0,0 +1,45 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = .@DS@gccifier@exe@ -CC"$(CC0)"
+CFLAGS0 = @CFLAGS@ -I@erl_interface_include@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@
+EI_COMMON_OBJS = runner@obj@ ei_runner@obj@
+ALL_OBJS = gccifier@exe@ $(EI_COMMON_OBJS)
+
+CP=cp
+CHMOD=chmod
+
+all: $(ALL_OBJS)
+
+@IFEQ@ (@erl_interface_cross_compile@, true)
+gccifier@exe@:
+ $(CP) gccifier.sh gccifier@exe@
+ $(CHMOD) a+x gccifier@exe@
+@ELSE@
+gccifier@exe@: gccifier.c
+ $(CC0) $(CFLAGS0) -o gccifier@exe@ gccifier.c
+@ENDIF@
+
+clean:
+ $(RM) $(EI_COMMON_OBJS)
+ $(RM) init_tc.beam
+ $(RM) gccifier@exe@
diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c
new file mode 100644
index 0000000000..205f911e38
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c
@@ -0,0 +1,400 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#ifndef __WIN32__
+#include <unistd.h>
+#endif
+#include <stdarg.h>
+
+#include "ei_runner.h"
+
+#ifndef __WIN32__
+#define _O_BINARY 0
+#define _setmode(fd, mode)
+#endif
+
+#define HEADER_SIZE 4
+
+static char* progname; /* Name of this program (from argv[0]). */
+static int fd_from_erl; /* File descriptor from Erlang. */
+static int fd_to_erl; /* File descriptor to Erlang. */
+
+static int packet_loop();
+static void ensure_buf_big_enough();
+static int readn();
+static void reply(char* buf, unsigned size);
+static void dump();
+
+void
+run_tests(char* argv0, TestCase test_cases[], unsigned number)
+{
+ int i;
+ int n;
+ char* packet;
+
+ progname = argv0;
+ _setmode(0, _O_BINARY);
+ _setmode(1, _O_BINARY);
+ fd_from_erl = 0;
+ fd_to_erl = 1;
+
+ packet = read_packet(&n);
+
+ /*
+ * Dispatch to the appropriate test function.
+ */
+
+ i = packet[0] * 256 + packet[1];
+ if (i >= number) {
+ fprintf(stderr, "%s: bad test case number %d",
+ progname, i);
+ free(packet);
+ exit(1);
+ } else {
+ (*test_cases[i])();
+ free(packet);
+ }
+}
+
+
+/***********************************************************************
+ *
+ * R e a d i n g p a c k e t s
+ *
+ ************************************************************************/
+
+/*
+ * Reads an Erlang term.
+ *
+ * Only accepts 't' (term) or 'e' (end of test),
+ * exits program on error
+ * returns 1 on 'e', 0 on 't'
+ */
+int get_bin_term(ei_x_buff* x, ei_term* term)
+{
+ int len, version;
+
+ ei_x_free(x);
+ x->buff = read_packet(&len);
+ x->buffsz = len;
+ x->index = 0;
+ switch (x->buff[x->index++]) {
+ case 'e':
+ return 1;
+ case 't':
+ if (ei_decode_version(x->buff, &x->index, &version) < 0
+ || ei_decode_ei_term(x->buff, &x->index, term) < 0) {
+ fail("Failed to decode term");
+ exit(0);
+ }
+ return 0;
+ default:
+ fprintf(stderr, "Garbage received: ");
+ dump(x->buff, len, 16);
+ putc('\n', stderr);
+ fail("C program received garbage");
+ exit(1);
+ }
+}
+
+
+/*
+ * Reads a packet from Erlang. The packet must be a standard {packet, 2}
+ * packet. This function aborts if any error is detected (including EOF).
+ *
+ * Returns: The number of bytes in the packet.
+ */
+
+char *read_packet(int *len)
+{
+
+ unsigned char* io_buf = NULL; /* Buffer for file i/o. */
+ int i;
+ unsigned char header[HEADER_SIZE];
+ unsigned packet_length; /* Length of current packet. */
+ int bytes_read;
+
+ /*
+ * Read the packet header.
+ */
+
+ bytes_read = readn(fd_from_erl, header, HEADER_SIZE);
+
+ if (bytes_read == 0) {
+ fprintf(stderr, "%s: Unexpected end of file\n", progname);
+ exit(1);
+ }
+ if (bytes_read != HEADER_SIZE) {
+ fprintf(stderr, "%s: Failed to read packet header\n", progname);
+ exit(1);
+ }
+
+ /*
+ * Get the length of this packet.
+ */
+
+ packet_length = 0;
+
+ for (i = 0; i < HEADER_SIZE; i++)
+ packet_length = (packet_length << 8) | header[i];
+
+ if (len) *len=packet_length; /* report length only if caller requested it */
+
+ if ((io_buf = (char *) malloc(packet_length)) == NULL) {
+ fprintf(stderr, "%s: insufficient memory for i/o buffer of size %d\n",
+ progname, packet_length);
+ exit(1);
+ }
+
+ /*
+ * Read the packet itself.
+ */
+
+ bytes_read = readn(fd_from_erl, io_buf, packet_length);
+ if (bytes_read != packet_length) {
+ fprintf(stderr, "%s: couldn't read packet of length %d\r\n",
+ progname, packet_length);
+ free(io_buf);
+ exit(1);
+ }
+
+ return io_buf;
+}
+
+
+/***********************************************************************
+ * S e n d i n g r e p l i e s
+ *
+ * The functions below send various types of replies back to Erlang.
+ * Each reply start with a letter indicating the type of reply.
+ *
+ * Reply Translated to on Erlang side
+ * ----- ----------------------------
+ * [$b|Bytes] {bytes, Bytes}
+ * [$e] eot
+ * [$f] test_server:fail()
+ * [$f|Reason] test_server:fail(Reason)
+ * [$t|EncodedTerm] {term, Term}
+ * [$N] 'NULL'
+ * [$m|Message] io:format("~s", [Message]) (otherwise ignored)
+ *
+ ***********************************************************************/
+
+/*
+ * This function reports the outcome of a test fail. It is useful if
+ * you implement a test case entirely in C code.
+ *
+ * If the ok argument is zero, a [$f] reply will be sent to the
+ * Erlang side (causing test_server:fail() to be called); otherwise,
+ * the atom 'eot' will be sent to Erlang.
+ *
+ * If you need to provide more details on a failure, use the fail() function.
+ */
+
+void
+do_report(file, line, ok)
+ char* file;
+ int line;
+ int ok; /* Zero if failed; non-zero otherwise. */
+{
+ char reason;
+ /*unsigned long ab;
+ unsigned long fb;*/
+
+ reason = ok ? 'e' : 'f';
+
+ if (!ok) {
+ do_fail(file, line, "Generic failure");
+ } else {
+ /* release all unallocated blocks */
+ /*erl_eterm_release();*/
+ /* check mem usage stats */
+ /*erl_eterm_statistics(&ab, &fb);*/
+ /*if ((ab == 0) && (fb == 0) ) {*/
+ reply(&reason, 1);
+ /*}
+ else {
+ char sbuf[128];
+
+ sprintf(sbuf, "still %lu terms allocated,"
+ " %lu on freelist at end of test", ab, fb);
+ do_fail(file, line, sbuf);
+ }*/
+ }
+}
+
+
+/*
+ * This function causes a call to test_server:fail(Reason) on the
+ * Erlang side.
+ */
+
+void do_fail(char* file, int line, char* reason)
+{
+ char sbuf[2048];
+
+ sbuf[0] = 'f';
+ sprintf(sbuf+1, "%s, line %d: %s", file, line, reason);
+ reply(sbuf, 1+strlen(sbuf+1));
+}
+
+/*
+ * This function sends a message to the Erlang side.
+ * The message will be written to the test servers log file,
+ * but will otherwise be completly ignored.
+ */
+
+void message(char* format, ...)
+{
+ va_list ap;
+ char sbuf[1024];
+
+ sbuf[0] = 'm';
+ va_start(ap, format);
+ vsprintf(sbuf+1, format, ap);
+ va_end(ap);
+
+ reply(sbuf, 1+strlen(sbuf+1));
+}
+
+/*
+ * This function sends the given binary term to the Erlang side,
+ * where it will be received as {term, Term} (prefix 't').
+ */
+void send_bin_term(ei_x_buff* x)
+{
+ ei_x_buff x2;
+ ei_x_new(&x2);
+ x2.buff[x2.index++] = 't';
+ ei_x_append(&x2, x);
+ reply(x2.buff, x2.index);
+ ei_x_free(&x2);
+}
+
+/*
+ * This function sends a raw buffer of data to the
+ * Erlang side, where it will be received as {bytes, Bytes} (prefix 'b').
+ */
+void send_buffer(char* buf, int size)
+{
+ char* send_buf;
+
+ send_buf = (char *) malloc(size+1);
+ send_buf[0] = 'b';
+ memcpy(send_buf+1, buf, size);
+ reply(send_buf, size+1);
+ free(send_buf);
+}
+
+/***********************************************************************
+ *
+ * P r i v a t e h e l p e r s
+ *
+ ***********************************************************************/
+
+/*
+ * Sends a packet back to Erlang.
+ */
+static void reply(char* reply_buf, unsigned size)
+{
+ int n; /* Temporary to hold size. */
+ int i; /* Loop counter. */
+ char* buf;
+
+
+ buf = (char *) malloc(size+HEADER_SIZE);
+ memcpy(buf+HEADER_SIZE, reply_buf, size);
+
+ /*
+ * Fill the header starting with the least significant byte.
+ */
+ n = size;
+ for (i = HEADER_SIZE-1; i >= 0; i--) {
+ buf[i] = (char) n; /* Store least significant byte. */
+ n = n >> 8;
+ }
+
+ size += HEADER_SIZE;
+ write(fd_to_erl, buf, size);
+ free(buf);
+}
+
+
+/*
+ * Reads len number of bytes.
+ */
+
+static int
+readn(fd, buf, len)
+ int fd; /* File descriptor to read from. */
+ unsigned char *buf; /* Store in this buffer. */
+ int len; /* Number of bytes to read. */
+{
+ int n; /* Byte count in last read call. */
+ int sofar = 0; /* Bytes read so far. */
+
+ do {
+ if ((n = read(fd, buf+sofar, len-sofar)) <= 0)
+ /* error or EOF in read */
+ return(n);
+ sofar += n;
+ } while (sofar < len);
+ return sofar;
+}
+
+void
+dump(buf, sz, max)
+ unsigned char* buf;
+ int sz;
+ int max;
+{
+ int i, imax;
+ char comma[5] = ",";
+
+ if (!sz)
+ return;
+ if (sz > max)
+ imax = max;
+ else
+ imax = sz;
+
+ for (i=0; i<imax; i++) {
+ if (i == imax-1) {
+ if (sz > max)
+ strcpy(comma, ",...");
+ else
+ comma[0] = 0;
+ }
+ if (isdigit(buf[i]))
+ fprintf(stderr, "%u%s", (int)(buf[i]), comma);
+ else {
+ if (isalpha(buf[i])) {
+ fprintf(stderr, "%c%s", buf[i], comma);
+ }
+ else
+ fprintf(stderr, "%u%s", (int)(buf[i]), comma);
+ }
+ }
+}
+
diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.h b/lib/erl_interface/test/all_SUITE_data/ei_runner.h
new file mode 100644
index 0000000000..96d6a1cbf7
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.h
@@ -0,0 +1,61 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "ei.h"
+
+typedef void (*TestCase)(void);
+
+#define TESTCASE(name) void name(void)
+#define ASIZE(a) (sizeof(a)/sizeof(a[0]))
+
+void run_tests(char* argv0, TestCase cases[], unsigned number);
+
+#ifndef _MSC_VER
+# define ll(val) (val##LL)
+#else /* assume gcc or C99 */
+# define ll(val) (val##i64)
+#endif
+
+#ifndef _MSC_VER
+# define ull(val) (val##LL)
+#else /* assume gcc or C99 */
+# define ull(val) (val##i64)
+#endif
+
+/*
+ * Reading.
+ */
+
+int get_bin_term(ei_x_buff* x, ei_term* term);
+char *read_packet(int *len);
+
+/*
+ * Sending replies.
+ */
+
+#define fail(reason) do_fail(__FILE__, __LINE__, reason)
+#define report(ok) do_report(__FILE__, __LINE__, ok)
+
+void do_report(char* file, int line, int ok);
+void do_fail(char* file, int line, char* reason);
+void send_buffer(char* buf, int size);
+void message(char* format, ...);
+
+void send_bin_term(ei_x_buff* x);
+
diff --git a/lib/erl_interface/test/all_SUITE_data/gccifier.c b/lib/erl_interface/test/all_SUITE_data/gccifier.c
new file mode 100644
index 0000000000..9f556fc4ed
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/gccifier.c
@@ -0,0 +1,317 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2005-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ *
+
+ */
+
+/*
+ * A compiler wrapper that translate (some) gcc command line arguments
+ * to the Visual C++ compiler and (of course) the gcc compiler. It also
+ * makes some changes in the command line arguments when debug compiling.
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdarg.h>
+
+
+#if !defined(__WIN32__)
+#define USE_EXEC
+#include <unistd.h>
+#endif
+
+
+#ifdef __WIN32__
+#define EOL "\r\n"
+#else
+#define EOL "\n"
+#endif
+
+#define ARGS_INCR 20
+
+static char *prog;
+
+typedef struct {
+ char **vec;
+ int no;
+ int ix;
+ int chars;
+} args_t;
+
+static void
+enomem(void)
+{
+ fprintf(stderr, "%s: Out of memory%s", prog, EOL);
+ exit(1);
+}
+
+static void
+save_arg(args_t *args, char *arg1, ...)
+{
+ char *carg;
+ va_list argp;
+
+ va_start(argp, arg1);
+ carg = arg1;
+ while (carg) {
+ if (args->no <= args->ix) {
+ args->vec = (char **) (args->no
+ ? realloc((void *) args->vec,
+ (sizeof(char *)
+ *(args->no + ARGS_INCR + 1)))
+ : malloc((sizeof(char *)
+ *(args->no + ARGS_INCR + 1))));
+ if (!args->vec)
+ enomem();
+ args->no += ARGS_INCR;
+ }
+ args->vec[args->ix++] = carg;
+ args->chars += strlen(carg);
+ carg = va_arg(argp, char *);
+ }
+ args->vec[args->ix++] = " ";
+ args->chars++;
+ va_end(argp);
+}
+
+static int
+is_prefix(char *prfx, char **str)
+{
+ int i;
+ for (i = 0; prfx[i] && (*str)[i]; i++) {
+ if (prfx[i] != (*str)[i])
+ return 0;
+ }
+ if (!prfx[i]) {
+ *str = &(*str)[i];
+ return 1;
+ }
+ return 0;
+}
+
+static void
+cpy(char **dst, char *src)
+{
+ int i;
+ for (i = 0; src[i]; i++)
+ (*dst)[i] = src[i];
+ *dst = &(*dst)[i];
+}
+
+typedef enum {
+ STDLIB_NONE,
+ STDLIB_MD,
+ STDLIB_ML,
+ STDLIB_MT
+} stdlib_t;
+
+int
+main(int argc, char *argv[])
+{
+ int res;
+ int i;
+ size_t cmd_len;
+ char *cmd;
+ char *cmd_end;
+ char *cc = NULL;
+ args_t args = {0};
+ int is_debug = 0;
+ int is_purify = 0;
+ int is_quantify = 0;
+ int is_purecov = 0;
+#ifdef __WIN32__
+ int is_shared = 0;
+ stdlib_t stdlib = STDLIB_NONE;
+ char *shared_flag = "";
+ char *stdlib_flag = "";
+ int have_link_args = 0;
+ args_t link_args = {0};
+
+#define CHECK_FIRST_LINK_ARG \
+ if (!have_link_args) { \
+ save_arg(&link_args, "-link", NULL); \
+ have_link_args = 1; \
+ }
+#else /* #ifdef __WIN32__ */
+#define CHECK_FIRST_LINK_ARG
+#endif /* #ifdef __WIN32__ */
+
+ prog = argv[0];
+
+
+ for (i = 1; i < argc; i++) {
+ char *arg = argv[i];
+ if (is_prefix("-CC", &arg)) {
+ cc = arg;
+ }
+ else if (is_prefix("-O", &arg)) {
+ if (!is_debug)
+ save_arg(&args, argv[i], NULL);
+ }
+ else if (strcmp("-DDEBUG", arg) == 0) {
+ save_arg(&args, arg, NULL);
+#ifdef __WIN32__
+ set_debug:
+#endif
+ if (!is_debug) {
+ int j;
+ is_debug = 1;
+#ifdef __WIN32__
+ save_arg(&args, "-Z7", NULL);
+ CHECK_FIRST_LINK_ARG;
+ save_arg(&link_args, "-debug", NULL);
+ save_arg(&link_args, "-pdb:none", NULL);
+#endif
+ for (j = 0; j < args.ix; j++) {
+ char *tmp_arg = args.vec[j];
+ if (is_prefix("-O", &tmp_arg))
+ args.vec[j] = "";
+ }
+ }
+ }
+ else if (strcmp("-DPURIFY", arg) == 0) {
+ save_arg(&args, arg, NULL);
+ is_purify = 1;
+ }
+ else if (strcmp("-DQUANTIFY", arg) == 0) {
+ save_arg(&args, arg, NULL);
+ is_quantify = 1;
+ }
+ else if (strcmp("-DPURECOV", arg) == 0) {
+ save_arg(&args, arg, NULL);
+ is_purecov = 1;
+ }
+#ifdef __WIN32__
+ else if (strcmp("-g", arg) == 0) {
+ goto set_debug;
+ }
+ else if (strcmp("-MD", arg) == 0)
+ stdlib = STDLIB_MD;
+ else if (strcmp("-MDd", arg) == 0) {
+ stdlib = STDLIB_MD;
+ goto set_debug;
+ }
+ else if (strcmp("-ML", arg) == 0)
+ stdlib = STDLIB_ML;
+ else if (strcmp("-MLd", arg) == 0) {
+ stdlib = STDLIB_ML;
+ goto set_debug;
+ }
+ else if (strcmp("-MT", arg) == 0)
+ stdlib = STDLIB_MT;
+ else if (strcmp("-MTd", arg) == 0) {
+ stdlib = STDLIB_MT;
+ goto set_debug;
+ }
+ else if (strcmp("-shared", arg) == 0 || strcmp("-LD", arg) == 0)
+ is_shared = 1;
+ else if (strcmp("-LDd", arg) == 0) {
+ is_shared = 1;
+ goto set_debug;
+ }
+ else if (strcmp("-Wall", arg) == 0) {
+ save_arg(&args, "-W3", NULL);
+ }
+ else if (is_prefix("-L", &arg)) {
+ CHECK_FIRST_LINK_ARG;
+ save_arg(&link_args, "-libpath:", arg, NULL);
+ }
+#endif /* #ifdef __WIN32__ */
+ else if (is_prefix("-l", &arg)) {
+ CHECK_FIRST_LINK_ARG;
+ if (is_debug && strcmp("ethread", arg) == 0)
+ arg = "ethread.debug";
+ else if (is_purify && strcmp("ethread", arg) == 0)
+ arg = "ethread.purify";
+ else if (is_quantify && strcmp("ethread", arg) == 0)
+ arg = "ethread.quantify";
+ else if (is_purecov && strcmp("ethread", arg) == 0)
+ arg = "ethread.purecov";
+#ifdef __WIN32__
+ else if (strcmp("socket", arg) == 0)
+ arg = "ws2_32";
+ save_arg(&link_args, arg, ".lib", NULL);
+#else
+ save_arg(&args, "-l", arg, NULL);
+#endif
+ }
+ else
+ save_arg(&args, argv[i], NULL);
+ }
+
+ if (!cc || !cc[0]) {
+ fprintf(stderr, "%s: Missing compulsory -CC flag%s", prog, EOL);
+ exit(1);
+ }
+
+ cmd_len = strlen(cc) + 1 + args.chars + 1;
+
+#ifdef __WIN32__
+ if (is_shared)
+ shared_flag = is_debug ? "-LDd " : "-LD ";
+ switch (stdlib) {
+ case STDLIB_MD: stdlib_flag = is_debug ? "-MDd " : "-MD "; break;
+ case STDLIB_ML: stdlib_flag = is_debug ? "-MLd " : "-ML "; break;
+ case STDLIB_MT: stdlib_flag = is_debug ? "-MTd " : "-MT "; break;
+ case STDLIB_NONE: break;
+ }
+
+ cmd_len += strlen(shared_flag) + strlen(stdlib_flag) + link_args.chars;
+#endif
+
+ cmd = (char *) malloc(sizeof(char) * cmd_len);
+
+ if (!cmd)
+ enomem();
+ cmd_end = cmd;
+ cpy(&cmd_end, cc);
+ cpy(&cmd_end, " ");
+#ifdef __WIN32__
+ cpy(&cmd_end, stdlib_flag);
+ cpy(&cmd_end, shared_flag);
+#endif
+ for (i = 0; i < args.ix; i++)
+ cpy(&cmd_end, args.vec[i]);
+#ifdef __WIN32__
+ for (i = 0; i < link_args.ix; i++)
+ cpy(&cmd_end, link_args.vec[i]);
+#endif
+ *cmd_end = '\0';
+
+ printf("==> %s%s", cmd, EOL);
+ fflush(stdout);
+
+#ifdef USE_EXEC
+ (void) execl("/bin/sh", "sh", "-c", cmd, (char *) NULL);
+ perror(NULL);
+ res = 1;
+#else
+ res = system(cmd);
+#endif
+
+ free((void *) args.vec);
+#ifdef __WIN32__
+ free((void *) link_args.vec);
+#endif
+ free((void *) cmd);
+
+ if (res < 0)
+ res = 1;
+ return res;
+}
diff --git a/lib/erl_interface/test/all_SUITE_data/gccifier.sh b/lib/erl_interface/test/all_SUITE_data/gccifier.sh
new file mode 100755
index 0000000000..42253213b1
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/gccifier.sh
@@ -0,0 +1,26 @@
+#!/bin/sh
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2005-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+CC=`echo "$1" | sed -e "s/-CC//"`
+shift
+echo "->"
+echo "$CC $*"
+$CC $*
+echo ""
diff --git a/lib/erl_interface/test/all_SUITE_data/init_tc.erl b/lib/erl_interface/test/all_SUITE_data/init_tc.erl
new file mode 100644
index 0000000000..8157d590fc
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/init_tc.erl
@@ -0,0 +1,101 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(init_tc).
+
+-export([run/1]).
+
+%% The argument should be a list of filenames (atoms), without extension
+%% A .c extension is assumed.
+%%
+
+run([Name|Rest]) ->
+ case catch run1(atom_to_list(Name)) of
+ {'EXIT', Reason} ->
+ io:format("Failed: ~p~n", [Reason]),
+ halt(1);
+ _Other ->
+ run(Rest)
+ end;
+run([]) ->
+ ok.
+
+run1(Name) ->
+ CFile = Name ++ ".c",
+ {ok, Bin} = file:read_file(CFile),
+ String = binary_to_list(Bin),
+
+ %% This ConstPart stuff is because you can't retrieve part of a match.
+ %% Long live Perl!
+
+ ConstPart = "\nTESTCASE\\(",
+ ConstPartLen = 10,
+ {match, Matches} = regexp:matches(String, ConstPart++"[_a-zA-Z]*"),
+ Cases = get_names(Matches, ConstPartLen, Bin, []),
+ generate(Name, Cases).
+
+get_names([{Start, Length}|Rest], Skip, Bin, Result) ->
+ Name = binary_to_list(Bin, Start+Skip, Start+Length-1),
+ get_names(Rest, Skip, Bin, [Name|Result]);
+get_names([], _Skip, _Bin, Result) ->
+ lists:reverse(Result).
+
+generate(TcName, Cases) ->
+ Hrl = TcName ++ "_cases.hrl",
+ {ok, HrlFile} = file:open(Hrl, write),
+ {ok, Dir} = file:get_cwd(),
+ generate_hrl(Cases, HrlFile, {filename:join(Dir, TcName), 0}),
+ file:close(HrlFile),
+ C = TcName ++ "_decl.c",
+ {ok, CFile} = file:open(C, write),
+ generate_c(Cases, CFile, TcName),
+ file:close(CFile).
+
+generate_hrl([Case|Rest], File, {Name, Number}) ->
+ io:format(File, "-define(~s, {\"~s\", ~w}).~n", [Case, Name, Number]),
+ generate_hrl(Rest, File, {Name, Number+1});
+generate_hrl([], _, _) ->
+ ok.
+
+generate_c(Cases, File, TcName) ->
+ E= case lists:prefix("ei_", TcName) of
+ true -> "ei_";
+ false -> ""
+ end,
+ io:format(File, "#include \"~srunner.h\"\n", [E]),
+ lists:foreach(
+ fun(Case) ->
+ io:format(File, "extern void ~s(void);~n",
+ [Case]) end,
+ Cases),
+ io:format(File, "~nstatic TestCase test_cases[] = {~n", []),
+ lists:foreach(fun(Case) -> io:format(File, " ~s,~n", [Case]) end, Cases),
+ io:format(File, "~s",
+ [["};\n\n",
+ "#ifdef VXWORKS\n",
+ "int ", TcName, "(int argc, char* argv[])\n",
+ "#else\n",
+ "int main(int argc, char* argv[])\n",
+ "#endif\n",
+ "{\n",
+ " run_tests(argv[0], test_cases, ",
+ "sizeof(test_cases)/sizeof(test_cases[0]));\n",
+ " return 0;\n",
+ "}\n"]]).
diff --git a/lib/erl_interface/test/all_SUITE_data/reclaim.h b/lib/erl_interface/test/all_SUITE_data/reclaim.h
new file mode 100644
index 0000000000..00fdfc38dc
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/reclaim.h
@@ -0,0 +1,151 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ *
+
+ */
+#ifndef _RECLAIM_H
+#define _RECLAIM_H
+
+
+/* The Erlang release for VxWorks includes a simple mechanism for
+ "resource reclamation" at task exit - it allows replacement of the
+ functions that open/close "files" and malloc/free memory with versions
+ that keep track, to be able to "reclaim" file descriptors and memory
+ when a task exits (regardless of *how* it exits).
+
+ The interface to this mechanism is made available via this file,
+ with the following caveats:
+
+ - The interface may change (or perhaps even be removed, though that
+ isn't likely until VxWorks itself provides similar functionality)
+ in future releases - i.e. you must always use the version of this
+ file that comes with the Erlang release you are using.
+
+ - Disaster is guaranteed if you use the mechanism incorrectly (see
+ below for the correct way), e.g. allocate memory with the "tracking"
+ version of malloc() and free it with the "standard" version of free().
+
+ - The mechanism (of course) incurs some performance penalty - thus
+ for a simple program you may be better off with careful programming,
+ making sure that you do whatever close()/free()/etc calls that are
+ appropriate at all exit points (though if you need to guard against
+ taskDelete() etc, things get messy...).
+
+ To use the mechanism, simply program your application normally, i.e.
+ use open()/close()/malloc()/free() etc as usual, but #include this
+ file before any usage of the relevant functions. NOTE: To avoid the
+ "disaster" mentioned above, you *must* #include it in *all* (or none)
+ of the files that manipulate a particular file descriptor, allocated
+ memory area, etc.
+
+ Before any task that uses this utility is loaded (which includes the
+ erlang emulator), the reclaim.o object file has to be loaded and
+ the function reclaim_init() has to be called. reclaim_init should be called
+ only _ONCE_ in a systems lifetime and has only a primitive guard
+ against multiple calls (i.e. a global variable is checked). Therefore
+ the initialization should occur either in the start script of the system
+ or (even better) in the usrInit() part of system initialization. The
+ object file itself should be loaded only once, so linking it with the
+ kernel is a good idea, linking with each application is an extremely bad
+ dito. Make really sure that it's loaded _before_ any application that
+ uses it if You want to load it in the startup script.
+
+ If You dont want to have #define's for the posix/stdio names
+ of the file/memory operations (i.e. no #define malloc save_malloc etc),
+ #define RECLAIM_NO_ALIAS in Your source before reclaim.h is included.
+*/
+
+#include <vxWorks.h> /* STATUS, size_t */
+#include <sockLib.h> /* struct sockaddr */
+#include <stdio.h> /* FILE */
+
+#if defined(__STDC__)
+#define _RECLAIM_DECL_FUN(RetType, FunName, ParamList) \
+extern RetType FunName##ParamList
+#define _RECLAIM_VOID_PTR void *
+#define _RECLAIM_VOID_PARAM void
+#define _RECLAIM_VOID_RETURN void
+#elif defined(__cplusplus)
+#define _RECLAIM_DECL_FUN(RetType, FunName, ParamList) \
+extern "C" RetType FunName##ParamList
+#define _RECLAIM_VOID_PTR void *
+#define _RECLAIM_VOID_PARAM
+#define _RECLAIM_VOID_RETURN void
+#else
+#define _RECLAIM_DECL_FUN(RetType, FunName, Ignore) extern RetType FunName()
+#define DECLARE_FUNCTION_TYPE(RetType, Type, PList) typedef RetType (* Type)()
+#define _RECLAIM_VOID_PTR char *
+#define _RECLAIM_VOID_PARAM
+#define _RECLAIM_VOID_RETURN
+#endif /* __STDC__ / __cplusplus */
+
+/* Initialize the facility, on a per system basis. */
+_RECLAIM_DECL_FUN(STATUS, reclaim_init, (_RECLAIM_VOID_PARAM));
+
+/* File descriptor operations */
+_RECLAIM_DECL_FUN(int,save_open,(char *, int, ...));
+_RECLAIM_DECL_FUN(int,save_creat,(char *, int));
+_RECLAIM_DECL_FUN(int,save_socket,(int, int, int));
+_RECLAIM_DECL_FUN(int,save_accept,(int, struct sockaddr *, int *));
+_RECLAIM_DECL_FUN(int,save_close,(int));
+/* Interface to add an fd to what's reclaimed even though it's not open with
+ one of the above functions */
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_RETURN, save_fd, (int fd));
+#ifndef RECLAIM_NO_ALIAS
+#define open save_open
+#define creat save_creat
+#define socket save_socket
+#define accept save_accept
+#define close save_close
+#endif
+/* Stdio file operations */
+_RECLAIM_DECL_FUN(FILE *, save_fopen, (char *, char *));
+_RECLAIM_DECL_FUN(FILE *, save_fdopen, (int, char *));
+_RECLAIM_DECL_FUN(FILE *, save_freopen, (char *, char *, FILE *));
+_RECLAIM_DECL_FUN(int, save_fclose, (FILE *));
+/* XXX Should do opendir/closedir too... */
+#ifndef RECLAIM_NO_ALIAS
+#define fopen save_fopen
+#define fdopen save_fdopen
+#define freopen save_freopen
+#define fclose save_fclose
+#endif
+/* Memory allocation */
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_malloc, (size_t));
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_calloc, (size_t, size_t));
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_realloc,
+ (_RECLAIM_VOID_PTR, size_t));
+_RECLAIM_DECL_FUN(void, save_free, (_RECLAIM_VOID_PTR));
+_RECLAIM_DECL_FUN(void, save_cfree, (_RECLAIM_VOID_PTR));
+#ifndef RECLAIM_NO_ALIAS
+#define malloc save_malloc
+#define calloc save_calloc
+#define realloc save_realloc
+#define free save_free
+#define cfree save_cfree
+#endif
+/* Generic interfaces to malloc etc... */
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, plain_malloc, (size_t));
+_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, plain_realloc,
+ (_RECLAIM_VOID_PTR, size_t));
+_RECLAIM_DECL_FUN(void, plain_free, (_RECLAIM_VOID_PTR));
+#endif /* _RECLAIM_H */
+
+
+
+
diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c
new file mode 100644
index 0000000000..24df0f5f40
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/runner.c
@@ -0,0 +1,457 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#ifndef __WIN32__
+#include <unistd.h>
+#endif
+#include <stdarg.h>
+
+#include "runner.h"
+
+#ifndef __WIN32__
+#define _O_BINARY 0
+#define _setmode(fd, mode)
+#endif
+
+#define HEADER_SIZE 4
+
+static char* progname; /* Name of this program (from argv[0]). */
+static int fd_from_erl; /* File descriptor from Erlang. */
+static int fd_to_erl; /* File descriptor to Erlang. */
+
+static int packet_loop();
+static void ensure_buf_big_enough();
+static int readn();
+static void reply(char* buf, unsigned size);
+static void dump();
+
+void
+run_tests(char* argv0, TestCase test_cases[], unsigned number)
+{
+ int i;
+ int n;
+ char* packet;
+
+ progname = argv0;
+ _setmode(0, _O_BINARY);
+ _setmode(1, _O_BINARY);
+ fd_from_erl = 0;
+ fd_to_erl = 1;
+
+ packet = read_packet(&n);
+
+ /*
+ * Dispatch to the appropriate test function.
+ */
+
+ i = packet[0] * 256 + packet[1];
+ if (i >= number) {
+ fprintf(stderr, "%s: bad test case number %d",
+ progname, i);
+ free(packet);
+ exit(1);
+ } else {
+ (*test_cases[i])();
+ free(packet);
+ }
+}
+
+
+/***********************************************************************
+ *
+ * R e a d i n g p a c k e t s
+ *
+ ************************************************************************/
+
+/*
+ * Reads an Erlang term.
+ *
+ * Returns: A pointer to a term (an ETERM structure) if there was
+ * at term available, or a NULL pointer if there was an 'eot' (end-of-test)
+ * packet. Aborts if anything else received.
+ */
+
+ETERM*
+get_term(void)
+{
+ char* encoded;
+ ETERM* term;
+ int n;
+
+ encoded = read_packet(&n);
+
+ switch (encoded[0]) {
+ case 'e':
+ free(encoded);
+ return NULL;
+ case 't':
+ term = erl_decode(encoded+1);
+ free(encoded);
+ if (term == NULL) {
+ fail("Failed to decode term");
+ exit(0);
+ }
+ return term;
+ default:
+ fprintf(stderr, "Garbage received: ");
+ dump(encoded, n, 16);
+ putc('\n', stderr);
+ fail("C program received garbage");
+ free(encoded);
+ exit(1);
+ }
+}
+
+
+/*
+ * Reads a packet from Erlang. The packet must be a standard {packet, 2}
+ * packet. This function aborts if any error is detected (including EOF).
+ *
+ * Returns: The number of bytes in the packet.
+ */
+
+char *read_packet(int *len)
+{
+
+ unsigned char* io_buf = NULL; /* Buffer for file i/o. */
+ int i;
+ unsigned char header[HEADER_SIZE];
+ unsigned packet_length; /* Length of current packet. */
+ int bytes_read;
+
+ /*
+ * Read the packet header.
+ */
+
+ bytes_read = readn(fd_from_erl, header, HEADER_SIZE);
+
+ if (bytes_read == 0) {
+ fprintf(stderr, "%s: Unexpected end of file\n", progname);
+ exit(1);
+ }
+ if (bytes_read != HEADER_SIZE) {
+ fprintf(stderr, "%s: Failed to read packet header\n", progname);
+ exit(1);
+ }
+
+ /*
+ * Get the length of this packet.
+ */
+
+ packet_length = 0;
+
+ for (i = 0; i < HEADER_SIZE; i++)
+ packet_length = (packet_length << 8) | header[i];
+
+ if (len) *len=packet_length; /* report length only if caller requested it */
+
+ if ((io_buf = (char *) malloc(packet_length)) == NULL) {
+ fprintf(stderr, "%s: insufficient memory for i/o buffer of size %d\n",
+ progname, packet_length);
+ exit(1);
+ }
+
+ /*
+ * Read the packet itself.
+ */
+
+ bytes_read = readn(fd_from_erl, io_buf, packet_length);
+ if (bytes_read != packet_length) {
+ fprintf(stderr, "%s: couldn't read packet of length %d\r\n",
+ progname, packet_length);
+ free(io_buf);
+ exit(1);
+ }
+
+ return io_buf;
+}
+
+
+/***********************************************************************
+ * S e n d i n g r e p l i e s
+ *
+ * The functions below send various types of replies back to Erlang.
+ * Each reply start with a letter indicating the type of reply.
+ *
+ * Reply Translated to on Erlang side
+ * ----- ----------------------------
+ * [$b|Bytes] {bytes, Bytes}
+ * [$e] eot
+ * [$f] test_server:fail()
+ * [$f|Reason] test_server:fail(Reason)
+ * [$t|EncodedTerm] {term, Term}
+ * [$N] 'NULL'
+ * [$m|Message] io:format("~s", [Message]) (otherwise ignored)
+ *
+ ***********************************************************************/
+
+/*
+ * This function reports the outcome of a test fail. It is useful if
+ * you implement a test case entirely in C code.
+ *
+ * If the ok argument is zero, a [$f] reply will be sent to the
+ * Erlang side (causing test_server:fail() to be called); otherwise,
+ * the atom 'eot' will be sent to Erlang.
+ *
+ * If you need to provide more details on a failure, use the fail() function.
+ */
+
+void
+do_report(file, line, ok)
+ char* file;
+ int line;
+ int ok; /* Zero if failed; non-zero otherwise. */
+{
+ char reason;
+ unsigned long ab;
+ unsigned long fb;
+
+ reason = ok ? 'e' : 'f';
+
+ if (!ok) {
+ do_fail(file, line, "Generic failure");
+ } else {
+ /* release all unallocated blocks */
+ erl_eterm_release();
+ /* check mem usage stats */
+ erl_eterm_statistics(&ab, &fb);
+ if ((ab == 0) && (fb == 0) ) {
+ reply(&reason, 1);
+ }
+ else {
+ char sbuf[128];
+
+ sprintf(sbuf, "still %lu terms allocated,"
+ " %lu on freelist at end of test", ab, fb);
+ do_fail(file, line, sbuf);
+ }
+ }
+}
+
+
+/*
+ * This function causes a call to test_server:fail(Reason) on the
+ * Erlang side.
+ */
+
+void
+do_fail(char* file, int line, char* reason)
+{
+ char sbuf[2048];
+
+ sbuf[0] = 'f';
+ sprintf(sbuf+1, "%s, line %d: %s", file, line, reason);
+ reply(sbuf, 1+strlen(sbuf+1));
+}
+
+/*
+ * This function sends a message to the Erlang side.
+ * The message will be written to the test servers log file,
+ * but will otherwise be completly ignored.
+ */
+
+void
+message(char* format, ...)
+{
+ va_list ap;
+ char sbuf[1024];
+
+ sbuf[0] = 'm';
+ va_start(ap, format);
+ vsprintf(sbuf+1, format, ap);
+ va_end(ap);
+
+ reply(sbuf, 1+strlen(sbuf+1));
+}
+
+/*
+ * This function sends the given term to the Erlang side,
+ * where it will be received as {term, Term}.
+ *
+ * If the given pointer is NULL (indicating an invalid term),
+ * the result on the Erlang side will be the atom 'NULL'.
+ *
+ * After sending the term, this function frees the term by
+ * calling erl_free_term().
+ */
+
+void
+send_term(term)
+ ETERM* term; /* Term to be sent to Erlang side. */
+{
+ char encoded[64*1024];
+ int n;
+
+ if (term == NULL) {
+ encoded[0] = 'N';
+ n = 1;
+ } else {
+ encoded[0] = 't';
+ n = 1 + erl_encode(term, encoded+1);
+ erl_free_term(term);
+ }
+ reply(encoded, n);
+}
+
+#if 0
+
+/* Seriously broken!!! */
+
+void
+send_bin_term(x_ei_buff* x)
+{
+ x_ei_buff x2;
+ x_ei_new(&x2);
+ x2.buff[x2.index++] = 't';
+ x_ei_append(&x2, x);
+ reply(x2.buff, x2.index);
+ free(x2.buff);
+}
+#endif
+
+/*
+ * This function sends a raw buffer of data to the
+ * Erlang side, where it will be received as {bytes, Bytes}.
+ */
+
+void
+send_buffer(buf, size)
+ char* buf; /* Buffer with bytes to send to Erlang. */
+ int size; /* Size of data to send to Erlang. */
+{
+ char* send_buf;
+
+ send_buf = (char *) malloc(size+1);
+ send_buf[0] = 'b';
+ memcpy(send_buf+1, buf, size);
+ reply(send_buf, size+1);
+ free(send_buf);
+}
+
+/***********************************************************************
+ *
+ * P r i v a t e h e l p e r s
+ *
+ ***********************************************************************/
+
+/*
+ * Sends a packet back to Erlang.
+ */
+
+static void
+reply(reply_buf, size)
+ char* reply_buf; /* Buffer with reply. */
+ unsigned size; /* Size of reply. */
+{
+ int n; /* Temporary to hold size. */
+ int i; /* Loop counter. */
+ char* buf;
+
+
+ buf = (char *) malloc(size+HEADER_SIZE);
+ memcpy(buf+HEADER_SIZE, reply_buf, size);
+
+ /*
+ * Fill the header starting with the least significant byte.
+ */
+
+ n = size;
+ for (i = HEADER_SIZE-1; i >= 0; i--) {
+ buf[i] = (char) n; /* Store least significant byte. */
+ n = n >> 8;
+ }
+
+ size += HEADER_SIZE;
+/*
+ fprintf(stderr, "\r\nReply size: %u\r\n",
+ (unsigned)buf[0] << 8 + (unsigned)buf[1]);
+
+ for (i = 0; i < size; i++) {
+ fprintf(stderr,"%u %c\r\n",buf[i],buf[i]);
+ }
+
+ fprintf(stderr, "\r\n");
+*/
+ write(fd_to_erl, buf, size);
+ free(buf);
+}
+
+
+/*
+ * Reads len number of bytes.
+ */
+
+static int
+readn(fd, buf, len)
+ int fd; /* File descriptor to read from. */
+ unsigned char *buf; /* Store in this buffer. */
+ int len; /* Number of bytes to read. */
+{
+ int n; /* Byte count in last read call. */
+ int sofar = 0; /* Bytes read so far. */
+
+ do {
+ if ((n = read(fd, buf+sofar, len-sofar)) <= 0)
+ /* error or EOF in read */
+ return(n);
+ sofar += n;
+ } while (sofar < len);
+ return sofar;
+}
+
+void
+dump(buf, sz, max)
+ unsigned char* buf;
+ int sz;
+ int max;
+{
+ int i, imax;
+ char comma[5] = ",";
+
+ if (!sz)
+ return;
+ if (sz > max)
+ imax = max;
+ else
+ imax = sz;
+
+ for (i=0; i<imax; i++) {
+ if (i == imax-1) {
+ if (sz > max)
+ strcpy(comma, ",...");
+ else
+ comma[0] = 0;
+ }
+ if (isdigit(buf[i]))
+ fprintf(stderr, "%u%s", (int)(buf[i]), comma);
+ else {
+ if (isalpha(buf[i])) {
+ fprintf(stderr, "%c%s", buf[i], comma);
+ }
+ else
+ fprintf(stderr, "%u%s", (int)(buf[i]), comma);
+ }
+ }
+}
+
diff --git a/lib/erl_interface/test/all_SUITE_data/runner.h b/lib/erl_interface/test/all_SUITE_data/runner.h
new file mode 100644
index 0000000000..fb29d5166d
--- /dev/null
+++ b/lib/erl_interface/test/all_SUITE_data/runner.h
@@ -0,0 +1,50 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_interface.h"
+
+typedef void (*TestCase)(void);
+
+#define TESTCASE(name) void name(void)
+#define ASIZE(a) (sizeof(a)/sizeof(a[0]))
+
+void run_tests(char* argv0, TestCase cases[], unsigned number);
+
+/*
+ * Reading.
+ */
+
+ETERM* get_term(void);
+char *read_packet(int *len);
+
+/*
+ * Sending replies.
+ */
+
+#define fail(reason) do_fail(__FILE__, __LINE__, reason)
+#define report(ok) do_report(__FILE__, __LINE__, ok)
+
+void do_report(char* file, int line, int ok);
+void do_fail(char* file, int line, char* reason);
+void send_term(ETERM* term);
+void send_buffer(char* buf, int size);
+void message(char* format, ...);
+
+void send_bin_term(ei_x_buff* x);
+
diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl
new file mode 100644
index 0000000000..bc83d6a62e
--- /dev/null
+++ b/lib/erl_interface/test/ei_accept_SUITE.erl
@@ -0,0 +1,151 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_accept_SUITE).
+
+-include("test_server.hrl").
+-include("ei_accept_SUITE_data/ei_accept_test_cases.hrl").
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2,
+ ei_accept/1, ei_threaded_accept/1]).
+
+-import(runner, [get_term/1,send_term/2]).
+
+all(suite) -> [ei_accept, ei_threaded_accept].
+
+init_per_testcase(_Case, Config) ->
+ Dog = ?t:timetrap(?t:minutes(0.25)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+ei_accept(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+
+% ?line AMsg={a,[message, with], " strings in it!", [-12, -23], 1.001},
+ %% shouldn't this be a bif or function or something?
+ ?line Myname= hd(tl(string:tokens(atom_to_list(node()), "@"))),
+ ?line io:format("Myname ~p ~n", [Myname]),
+ ?line EINode= list_to_atom("c42@"++Myname),
+ ?line io:format("EINode ~p ~n", [EINode]),
+ ?line Self= self(),
+ ?line TermToSend= {call, Self, "Test"},
+ ?line F= fun() ->
+ timer:sleep(500),
+ {any, EINode} ! TermToSend,
+ Self ! sent_ok,
+ ok
+ end,
+
+ ?line spawn(F),
+ ?line Port = 6543,
+ ?line {ok, Fd, _Node} = ei_accept(P, Port),
+ ?line TermReceived= ei_receive(P, Fd),
+ ?line io:format("Sent ~p received ~p ~n", [TermToSend, TermReceived]),
+ ?line TermToSend= TermReceived,
+ ?line receive
+ sent_ok ->
+ ok;
+ Unknown ->
+ io:format("~p ~n", [Unknown])
+ after 1000 ->
+ io:format("timeout ~n")
+ end,
+ ?line ok= ei_unpublish(P),
+ ok.
+
+ei_threaded_accept(Config) when is_list(Config) ->
+ ?line Einode = filename:join(?config(data_dir, Config), "eiaccnode"),
+ ?line N = 1, % 3,
+ ?line Host = atom_to_list(node()),
+ ?line Port = 6767,
+ ?line start_einode(Einode, N, Host, Port),
+ ?line io:format("started eiaccnode"),
+ %%?line spawn_link(fun() -> start_einode(Einode, N, Host, Port) end),
+ ?line TestServerPid = self(),
+ ?line [ spawn_link(fun() -> send_rec_einode(I, TestServerPid) end)
+ || I <- lists:seq(0, N-1) ],
+ ?line [ receive I -> ok end
+ || I <- lists:seq(0, N-1) ],
+ ok.
+
+send_rec_einode(N, TestServerPid) ->
+ ?line Myname= hd(tl(string:tokens(atom_to_list(node()), "@"))),
+ ?line EINode= list_to_atom("eiacc" ++ integer_to_list(N) ++ "@" ++ Myname),
+ ?line io:format("EINode ~p ~n", [EINode]),
+ ?line Self= self(),
+ ?line timer:sleep(10*1000),
+ ?line {any, EINode} ! Self,
+ ?line receive
+ {N,_}=X ->
+ ?line io:format("Received by ~s ~p~n", [EINode, X]),
+ ?line TestServerPid ! N,
+ ?line X
+ after 10000 ->
+ ?line test_server:fail(EINode)
+ end.
+
+start_einode(Einode, N, Host, Port) ->
+ Einodecmd = Einode ++ " " ++ atom_to_list(erlang:get_cookie())
+ ++ " " ++ integer_to_list(N) ++ " " ++ Host ++ " "
+ ++ integer_to_list(Port) ++ " nothreads",
+ io:format("Einodecmd ~p ~n", [Einodecmd]),
+ ?line open_port({spawn, Einodecmd}, []),
+ ok.
+
+
+
+%%% Interface functions for ei (erl_interface) functions.
+
+ei_connect_init(P, Num, Cookie, Creation) ->
+ send_command(P, ei_connect_init, [Num,Cookie,Creation]),
+ case get_term(P) of
+ {term,Int} when is_integer(Int) -> Int
+ end.
+
+ei_accept(P, PortNo) ->
+ send_command(P, ei_accept, [PortNo]),
+ case get_term(P) of
+ {term,{Fd, _, Node}} when Fd >= 0 -> {ok, Fd, Node};
+ {term,{_Fd, Errno, _Node}} -> {error,Errno}
+ end.
+
+ei_receive(P, Fd) ->
+ send_command(P, ei_receive, [Fd]),
+ {term, T}= get_term(P),
+ T.
+
+ei_unpublish(P) ->
+ send_command(P, ei_unpublish, []),
+ case get_term(P) of
+ {term,{0, _}} -> ok;
+ {term,{_X, Errno}} -> {error,Errno}
+ end.
+
+send_command(P, Name, Args) ->
+ runner:send_term(P, {Name,list_to_tuple(Args)}).
+
+
+
+
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..d7ec976cd0
--- /dev/null
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_accept_test_decl.c: ei_accept_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_accept_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..9b751d8f65
--- /dev/null
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src
@@ -0,0 +1,45 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_ACCEPT_OBJS = ei_accept_test@obj@ ei_accept_test_decl@obj@
+EIACCNODE_OBJS = eiaccnode@obj@
+
+all: ei_accept_test@exe@ eiaccnode@exe@
+
+clean:
+ $(RM) $(EI_ACCEPT_OBJS) $(EIACCNODE_OBJS)
+ $(RM) ei_accept_test@exe@ eiaccnode@exe@
+
+ei_accept_test@exe@: $(EI_ACCEPT_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_ACCEPT_OBJS) $(LIBFLAGS)
+
+
+eiaccnode@exe@: $(EIACCNODE_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EIACCNODE_OBJS) $(LIBFLAGS)
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
new file mode 100644
index 0000000000..5f898b5944
--- /dev/null
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
@@ -0,0 +1,224 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Tests the accept function in ei_connect.c.
+ * Author: Jakob Cederlund (taken from erl_connect by Bj�rn Gustavsson)
+ *
+ * See the ei_accept_SUITE.erl file for a "table of contents".
+ */
+
+#include <stdio.h>
+#include <string.h>
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#ifdef __WIN32__
+#include <winsock2.h>
+#include <windows.h>
+#else
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#endif
+
+#include "ei_runner.h"
+
+static void cmd_ei_connect_init(char* buf, int len);
+static void cmd_ei_accept(char* buf, int len);
+static void cmd_ei_receive(char* buf, int len);
+static void cmd_ei_unpublish(char* buf, int len);
+
+static void send_errno_result(int value);
+
+ei_cnode ec;
+
+
+static struct {
+ char* name;
+ int num_args; /* Number of arguments. */
+ void (*func)(char* buf, int len);
+} commands[] = {
+ "ei_connect_init", 3, cmd_ei_connect_init,
+ "ei_accept", 1, cmd_ei_accept,
+ "ei_receive", 1, cmd_ei_receive,
+ "ei_unpublish", 0, cmd_ei_unpublish
+};
+
+/*
+ * Sends a list contaning all data types to the Erlang side.
+ */
+TESTCASE(interpret)
+{
+ ei_x_buff x;
+ int i;
+ ei_term term;
+
+ ei_x_new(&x);
+ for (;;) {
+ if (get_bin_term(&x, &term)) {
+ report(1);
+ return;
+ } else {
+ char* buf = x.buff, func[MAXATOMLEN];
+ int index = x.index, arity;
+ if (term.ei_type != ERL_SMALL_TUPLE_EXT || term.arity != 2)
+ fail("term should be a tuple of size 2");
+ if (ei_decode_atom(buf, &index, func) < 0)
+ fail("function name should be an atom");
+ if (ei_decode_tuple_header(buf, &index, &arity) != 0)
+ fail("function arguments should be a tuple");
+ for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) {
+ if (strcmp(func, commands[i].name) == 0) {
+ if (arity != commands[i].num_args)
+ fail("wrong number of arguments");
+ commands[i].func(buf + index, x.buffsz - index);
+ break;
+ }
+ }
+ if (i >= sizeof(commands)/sizeof(commands[0])) {
+ message("\"%d\" \n", func);
+ fail("bad command");
+ }
+ }
+ }
+}
+
+static void cmd_ei_connect_init(char* buf, int len)
+{
+ int index = 0, r = 0;
+ int type, size;
+ long l;
+ char b[100];
+ char cookie[MAXATOMLEN], * cp = cookie;
+ ei_x_buff res;
+ if (ei_decode_long(buf, &index, &l) < 0)
+ fail("expected int");
+ sprintf(b, "c%d", l);
+ /* FIXME don't use internal and maybe use skip?! */
+ ei_get_type_internal(buf, &index, &type, &size);
+ if (ei_decode_atom(buf, &index, cookie) < 0)
+ fail("expected atom (cookie)");
+ if (cookie[0] == '\0')
+ cp = NULL;
+ r = ei_connect_init(&ec, b, cp, 0);
+ ei_x_new_with_version(&res);
+ ei_x_encode_long(&res, r);
+ send_bin_term(&res);
+ ei_x_free(&res);
+}
+
+static int my_listen(int port)
+{
+ int listen_fd;
+ struct sockaddr_in addr;
+ const char *on = "1";
+
+ if ((listen_fd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+ return -1;
+
+ setsockopt(listen_fd, SOL_SOCKET, SO_REUSEADDR, on, sizeof(on));
+
+ memset((void*) &addr, 0, (size_t) sizeof(addr));
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons(port);
+ addr.sin_addr.s_addr = htonl(INADDR_ANY);
+
+ if (bind(listen_fd, (struct sockaddr*) &addr, sizeof(addr)) < 0)
+ return -1;
+
+ listen(listen_fd, 5);
+ return listen_fd;
+}
+
+static void cmd_ei_accept(char* buf, int len)
+{
+ int index = 0;
+ int listen, r;
+ ErlConnect conn;
+ long port;
+ ei_x_buff x;
+ int i;
+
+ /* get port */
+ if (ei_decode_long(buf, &index, &port) < 0)
+ fail("expected int (port)");
+ /* Make a listen socket */
+ if ((listen = my_listen(port)) <= 0)
+ fail("listen");
+
+ if ((i = ei_publish(&ec, port)) == -1)
+ fail("ei_publish");
+#ifdef VXWORKS
+ save_fd(i);
+#endif
+ r = ei_accept(&ec, listen, &conn);
+#ifdef VXWORKS
+ save_fd(r);
+#endif
+ /* send result, errno and nodename */
+ ei_x_new_with_version(&x);
+ ei_x_encode_tuple_header(&x, 3);
+ ei_x_encode_long(&x, r);
+ ei_x_encode_long(&x, erl_errno);
+ ei_x_encode_atom(&x, conn.nodename); /* or rather string? */
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
+
+static void cmd_ei_receive(char* buf, int len)
+{
+ ei_x_buff x;
+ erlang_msg msg;
+ long l;
+ int fd, index = 0;
+
+ if (ei_decode_long(buf, &index, &l) < 0)
+ fail("expected int (fd)");
+ fd = l;
+ ei_x_new(&x);
+ for (;;) {
+ int got = ei_xreceive_msg(fd, &msg, &x);
+ if (got == ERL_TICK)
+ continue;
+ if (got == ERL_ERROR)
+ fail("ei_xreceive_msg");
+ break;
+ }
+ index = 1;
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
+
+static void cmd_ei_unpublish(char* buf, int len)
+{
+ send_errno_result(ei_unpublish(&ec));
+}
+
+static void send_errno_result(int value)
+{
+ ei_x_buff x;
+ ei_x_new_with_version(&x);
+ ei_x_encode_tuple_header(&x, 2);
+ ei_x_encode_long(&x, value);
+ ei_x_encode_long(&x, erl_errno);
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c
new file mode 100644
index 0000000000..af58f75963
--- /dev/null
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c
@@ -0,0 +1,234 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/* to test multiple threads in ei */
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#ifdef __WIN32__
+#include <winsock2.h>
+#include <windows.h>
+#include <process.h>
+#else
+#ifndef VXWORKS
+#include <pthread.h>
+#endif
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#endif
+
+#include "ei.h"
+
+#ifdef VXWORKS
+#include <vxWorks.h>
+#include <sockLib.h>
+#include <inetLib.h>
+#define MAIN cnode
+#else
+#define MAIN main
+#endif
+
+static int my_listen(int port);
+
+/*
+ A small einode.
+ To be called from the test case ei_accept_SUITE:multi_thread
+ usage: eiaccnode <cookie> <n>
+
+ - start threads 0..n-1
+ - in each thread
+ - listen on "ei0" .. "ei<n-1>"
+ - wait for connection
+ - receive a pid
+ - send {i, <pid>} back
+ - shutdown gracefully
+*/
+
+static const char* cookie, * desthost;
+static int port; /* actually base port */
+
+#ifndef SD_SEND
+#ifdef SHUTWR
+#define SD_SEND SHUT_WR
+#else
+#define SD_SEND 1
+#endif
+#endif
+
+#ifndef __WIN32__
+#define closesocket(fd) close(fd)
+#endif
+
+#ifdef __WIN32__
+static DWORD WINAPI
+#else
+static void*
+#endif
+ einode_thread(void* num)
+{
+ int n = (int)num;
+ ei_cnode ec;
+ char myname[100], destname[100];
+ int r, fd, listen;
+ ErlConnect conn;
+ erlang_msg msg;
+/* FILE* f;*/
+
+ sprintf(myname, "eiacc%d", n);
+ printf("thread %d (%s) listening\n", n, myname, destname);
+ r = ei_connect_init(&ec, myname, cookie, 0);
+ if ((listen = my_listen(port+n)) <= 0) {
+ printf("listen err\n");
+ exit(7);
+ }
+ if (ei_publish(&ec, port + n) == -1) {
+ printf("ei_publish port %d\n", port+n);
+ exit(8);
+ }
+ fd = ei_accept(&ec, listen, &conn);
+ printf("ei_accept %d\n", fd);
+ if (fd >= 0) {
+ ei_x_buff x, xs;
+ int index, version;
+ erlang_pid pid;
+
+ ei_x_new(&x);
+ for (;;) {
+ int got = ei_xreceive_msg(fd, &msg, &x);
+ if (got == ERL_TICK)
+ continue;
+ if (got == ERL_ERROR) {
+ printf("receive error %d\n", n);
+ return 0;
+ }
+ printf("received %d\n", got);
+ break;
+ }
+ index = 0;
+ if (ei_decode_version(x.buff, &index, &version) != 0) {
+ printf("ei_decode_version %d\n", n);
+ return 0;
+ }
+ if (ei_decode_pid(x.buff, &index, &pid) != 0) {
+ printf("ei_decode_pid %d\n", n);
+ return 0;
+ }
+/* fprintf(f, "got pid from %s \n", pid.node);*/
+ ei_x_new_with_version(&xs);
+ ei_x_encode_tuple_header(&xs, 2);
+ ei_x_encode_long(&xs, n);
+ ei_x_encode_pid(&xs, &pid);
+ r = ei_send(fd, &pid, xs.buff, xs.index);
+/* fprintf(f, "sent %d bytes %d\n", xs.index, r);*/
+ shutdown(fd, SD_SEND);
+ closesocket(fd);
+ ei_x_free(&x);
+ ei_x_free(&xs);
+ } else {
+ printf("coudn't connect fd %d r %d\n", fd, r);
+ }
+ printf("done thread %d\n", n);
+/* fclose(f);*/
+ return 0;
+}
+
+MAIN(int argc, char *argv[])
+{
+ int i, n, no_threads;
+#ifndef VXWORKS
+#ifdef __WIN32__
+ HANDLE threads[100];
+#else
+ pthread_t threads[100];
+#endif
+#endif
+
+ if (argc < 3)
+ exit(1);
+
+ cookie = argv[1];
+ n = atoi(argv[2]);
+ if (n > 100)
+ exit(2);
+ desthost = argv[3];
+ port = atoi(argv[4]);
+#ifndef VXWORKS
+ no_threads = argv[5] != NULL && strcmp(argv[5], "nothreads") == 0;
+#else
+ no_threads = 1;
+#endif
+ for (i = 0; i < n; ++i) {
+ if (!no_threads) {
+#ifndef VXWORKS
+#ifdef __WIN32__
+ unsigned tid;
+ threads[i] = (HANDLE)_beginthreadex(NULL, 0, einode_thread,
+ (void*)i, 0, &tid);
+#else
+ pthread_create(&threads[i], NULL, einode_thread, (void*)i);
+#endif
+#else
+ ;
+#endif
+ } else
+ einode_thread((void*)i);
+ }
+
+ if (!no_threads)
+#ifndef VXWORKS
+ for (i = 0; i < n; ++i) {
+#ifdef __WIN32__
+ if (WaitForSingleObject(threads[i], INFINITE) != WAIT_OBJECT_0)
+#else
+ if (pthread_join(threads[i], NULL) != 0)
+#endif
+ printf("bad wait thread %d\n", i);
+ }
+#else
+ ;
+#endif
+ printf("ok\n");
+ return 0;
+}
+
+static int my_listen(int port)
+{
+ int listen_fd;
+ struct sockaddr_in addr;
+ const char *on = "1";
+
+ if ((listen_fd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+ return -1;
+
+ setsockopt(listen_fd, SOL_SOCKET, SO_REUSEADDR, on, sizeof(on));
+
+ memset((void*) &addr, 0, (size_t) sizeof(addr));
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons(port);
+ addr.sin_addr.s_addr = htonl(INADDR_ANY);
+
+ if (bind(listen_fd, (struct sockaddr*) &addr, sizeof(addr)) < 0)
+ return -1;
+
+ listen(listen_fd, 5);
+ return listen_fd;
+}
+
diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl
new file mode 100644
index 0000000000..56f478edad
--- /dev/null
+++ b/lib/erl_interface/test/ei_connect_SUITE.erl
@@ -0,0 +1,218 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_connect_SUITE).
+
+-include("test_server.hrl").
+-include("ei_connect_SUITE_data/ei_connect_test_cases.hrl").
+
+-export([
+ all/1,
+ init_per_testcase/2,
+ fin_per_testcase/2,
+
+ ei_send/1,
+ ei_reg_send/1,
+ ei_rpc/1,
+ rpc_test/1,
+ ei_send_funs/1,
+ ei_threaded_send/1,
+ ei_set_get_tracelevel/1
+ ]).
+
+-import(runner, [get_term/1,send_term/2]).
+
+all(suite) -> [ ei_send,
+ ei_reg_send,
+ ei_rpc,
+ ei_send_funs,
+ ei_threaded_send,
+ ei_set_get_tracelevel].
+
+init_per_testcase(_Case, Config) ->
+ Dog = ?t:timetrap(?t:minutes(0.25)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+ei_send(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ?line ok = ei_send(P, Fd, self(), AMsg={a,message}),
+ ?line receive AMsg -> ok end,
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+ei_send_funs(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ?line Fun1 = fun ei_send/1,
+ ?line Fun2 = fun(X) -> P, X, Fd, Fun1 end,
+
+ ?line AMsg={Fun1,Fun2},
+ %%AMsg={wait_with_funs, new_dist_format},
+ ?line ok = ei_send_funs(P, Fd, self(), AMsg),
+ ?line EIMsg = receive M -> M end,
+ ?line EIMsg = AMsg,
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+ei_reg_send(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ARegName = a_strange_registred_name,
+ ?line register(ARegName, self()),
+ ?line ok = ei_reg_send(P, Fd, ARegName, AMsg={another,[strange],message}),
+ ?line receive AMsg -> ok end,
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+ei_threaded_send(Config) when is_list(Config) ->
+ ?line Einode = filename:join(?config(data_dir, Config), "einode"),
+ ?line N = 15,
+ ?line Host = atom_to_list(node()),
+ ?line spawn_link(fun() -> start_einode(Einode, N, Host) end),
+ ?line TestServerPid = self(),
+ ?line [ spawn_link(fun() -> rec_einode(I, TestServerPid) end)
+ || I <- lists:seq(0, N-1) ],
+ ?line [ receive I -> ok end
+ || I <- lists:seq(0, N-1) ],
+ ok.
+
+rec_einode(N, TestServerPid) ->
+ ?line Regname = list_to_atom("mth"++integer_to_list(N)),
+ ?line register(Regname, self()),
+ ?line io:format("~p waiting~n", [Regname]),
+ ?line receive
+ X ->
+ ?line io:format("Received by ~s ~p~n", [Regname, X]),
+ ?line TestServerPid ! N,
+ ?line X
+ after 10000 ->
+ ?line test_server:fail(Regname)
+ end.
+
+start_einode(Einode, N, Host) ->
+ Einodecmd = Einode ++ " " ++ atom_to_list(erlang:get_cookie())
+ ++ " " ++ integer_to_list(N) ++ " " ++ Host,
+ io:format("Einodecmd ~p ~n", [Einodecmd]),
+ ?line open_port({spawn, Einodecmd}, []),
+ ok.
+
+ei_rpc(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ?line S= "Hej du glade!", SRev = lists:reverse(S),
+ ?line X = ei_rpc(P, Fd, self(), {?MODULE, rpc_test}, [SRev]),
+ ?line {term, S}= X,
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+ei_set_get_tracelevel(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 5 = ei_set_get_tracelevel(P, 5),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ?line S= "Hej du glade!", SRev = lists:reverse(S),
+ ?line X = ei_rpc(P, Fd, self(), {?MODULE, rpc_test}, [SRev]),
+ ?line {term, S}= X,
+
+ ?line 0 = ei_set_get_tracelevel(P, 0),
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%%% Interface functions for ei (erl_interface) functions.
+
+ei_connect_init(P, Num, Cookie, Creation) ->
+ send_command(P, ei_connect_init, [Num,Cookie,Creation]),
+ case get_term(P) of
+ {term,Int} when is_integer(Int) -> Int
+ end.
+
+ei_connect(P, Node) ->
+ send_command(P, ei_connect, [Node]),
+ case get_term(P) of
+ {term,{Fd,_}} when Fd >= 0 -> {ok,Fd};
+ {term,{-1,Errno}} -> {error,Errno}
+ end.
+
+ei_set_get_tracelevel(P, Tracelevel) ->
+ send_command(P, ei_set_get_tracelevel, [Tracelevel]),
+ case get_term(P) of
+ {term,{tracelevel, Level}} when is_integer(Level) -> Level
+ end.
+
+ei_send(P, Fd, To, Msg) ->
+ send_command(P, ei_send, [Fd,To,Msg]),
+ get_send_result(P).
+
+ei_send_funs(P, Fd, To, Msg) ->
+ send_command(P, ei_send_funs, [Fd,To,Msg]),
+ get_send_result(P).
+
+ei_reg_send(P, Fd, To, Msg) ->
+ send_command(P, ei_reg_send, [Fd,To,Msg]),
+ get_send_result(P).
+
+ei_rpc(P, Fd, To, Func, Msg) ->
+ send_command(P, ei_rpc, [Fd, To, Func, Msg]),
+ get_term(P).
+
+
+get_send_result(P) ->
+ case get_term(P) of
+ {term,{0,_}} -> ok;
+ {term,{1,_}} -> ok;
+ {term,{-1,Errno}} -> {error,Errno};
+ {term,{Res,Errno}}->
+ io:format("Return value: ~p\nerl_errno: ~p", [Res,Errno]),
+ ?t:fail(bad_return_value)
+ end.
+
+send_command(P, Name, Args) ->
+ runner:send_term(P, {Name,list_to_tuple(Args)}).
+
+%%% Test function for RPC
+
+rpc_test(S) ->
+ lists:reverse(S).
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..8bf22e366e
--- /dev/null
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_connect_test_decl.c: ei_connect_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_connect_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..a6525a9138
--- /dev/null
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src
@@ -0,0 +1,46 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_CONNECT_OBJS = ei_connect_test@obj@ ei_connect_test_decl@obj@
+EINODE_OBJS = einode@obj@
+
+all: ei_connect_test@exe@ einode@exe@
+
+clean:
+ $(RM) $(EI_CONNECT_OBJS) $(EINODE_OBJS)
+ $(RM) ei_connect_test@exe@ einode@exe@
+
+ei_connect_test@exe@: $(EI_CONNECT_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_CONNECT_OBJS) $(LIBFLAGS)
+
+
+einode@exe@: $(EINODE_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EINODE_OBJS) $(LIBFLAGS)
+
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
new file mode 100644
index 0000000000..debd3e789b
--- /dev/null
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
@@ -0,0 +1,289 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Tests the functions in ei_connect.c.
+ * Author: Bjorn Gustavsson (rewritten somewhat by Jakob Cederlund)
+ *
+ * See the ei_connect_SUITE.erl file for a "table of contents".
+ */
+
+#include <stdio.h>
+#include <string.h>
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#include "ei_runner.h"
+
+static void cmd_ei_connect_init(char* buf, int len);
+static void cmd_ei_connect(char* buf, int len);
+static void cmd_ei_send(char* buf, int len);
+static void cmd_ei_send_funs(char* buf, int len);
+static void cmd_ei_reg_send(char* buf, int len);
+static void cmd_ei_rpc(char* buf, int len);
+static void cmd_ei_set_get_tracelevel(char* buf, int len);
+
+static void send_errno_result(int value);
+
+ei_cnode ec;
+
+
+static struct {
+ char* name;
+ int num_args; /* Number of arguments. */
+ void (*func)(char* buf, int len);
+} commands[] = {
+ "ei_connect_init", 3, cmd_ei_connect_init,
+ "ei_connect", 1, cmd_ei_connect,
+ "ei_send", 3, cmd_ei_send,
+ "ei_send_funs", 3, cmd_ei_send_funs,
+ "ei_reg_send", 3, cmd_ei_reg_send,
+ "ei_rpc", 4, cmd_ei_rpc,
+ "ei_set_get_tracelevel", 1, cmd_ei_set_get_tracelevel,
+};
+
+
+/*
+ * Sends a list contaning all data types to the Erlang side.
+ */
+
+TESTCASE(interpret)
+{
+ ei_x_buff x;
+ int i;
+ ei_term term;
+
+ ei_x_new(&x);
+ for (;;) {
+ if (get_bin_term(&x, &term)) {
+ report(1);
+ return;
+ } else {
+ char* buf = x.buff, func[MAXATOMLEN];
+ int index = x.index, arity;
+ if (term.ei_type != ERL_SMALL_TUPLE_EXT || term.arity != 2)
+ fail("term should be a tuple of size 2");
+ if (ei_decode_atom(buf, &index, func) < 0)
+ fail("function name should be an atom");
+ if (ei_decode_tuple_header(buf, &index, &arity) != 0)
+ fail("function arguments should be a tuple");
+ for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) {
+ if (strcmp(func, commands[i].name) == 0) {
+ if (arity != commands[i].num_args)
+ fail("wrong number of arguments");
+ commands[i].func(buf + index, x.buffsz - index);
+ break;
+ }
+ }
+ if (i >= sizeof(commands)/sizeof(commands[0])) {
+ message("\"%d\" \n", func);
+ fail("bad command");
+ }
+ }
+ }
+}
+
+
+static void cmd_ei_connect_init(char* buf, int len)
+{
+ int index = 0, r = 0;
+ int type, size;
+ long l;
+ char b[100];
+ char cookie[MAXATOMLEN], * cp = cookie;
+ ei_x_buff res;
+ if (ei_decode_long(buf, &index, &l) < 0)
+ fail("expected int");
+ sprintf(b, "c%d", l);
+ /* FIXME don't use internal and maybe use skip?! */
+ ei_get_type_internal(buf, &index, &type, &size);
+ if (ei_decode_atom(buf, &index, cookie) < 0)
+ fail("expected atom (cookie)");
+ if (cookie[0] == '\0')
+ cp = NULL;
+ r = ei_connect_init(&ec, b, cp, 0);
+ ei_x_new_with_version(&res);
+ ei_x_encode_long(&res, r);
+ send_bin_term(&res);
+ ei_x_free(&res);
+}
+
+static void cmd_ei_connect(char* buf, int len)
+{
+ int index = 0;
+ char node[256];
+ int i;
+ if (ei_decode_atom(buf, &index, node) < 0)
+ fail("expected atom");
+ i=ei_connect(&ec, node);
+#ifdef VXWORKS
+ if(i >= 0) {
+ save_fd(i);
+ }
+#endif
+ send_errno_result(i);
+}
+
+static void cmd_ei_set_get_tracelevel(char* buf, int len)
+{
+ int index = 0;
+ long level = 0;
+ long ret = 0;
+ ei_x_buff x;
+
+ if (ei_decode_long(buf, &index, &level) < 0) {
+ fail("expected long");
+ }
+
+ ei_set_tracelevel((int)level);
+
+ ret = (long) ei_get_tracelevel();
+
+ ei_x_new_with_version(&x);
+ ei_x_encode_tuple_header(&x, 2);
+ ei_x_encode_atom(&x, "tracelevel");
+ ei_x_encode_long(&x, ret);
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
+
+static void cmd_ei_send(char* buf, int len)
+{
+ int index = 0;
+ long fd;
+ erlang_pid pid;
+ ei_x_buff x;
+
+ if (ei_decode_long(buf, &index, &fd) < 0)
+ fail("expected long");
+ if (ei_decode_pid(buf, &index, &pid) < 0)
+ fail("expected pid (node)");
+ if (ei_x_new_with_version(&x) < 0)
+ fail("ei_x_new_with_version");
+ if (ei_x_append_buf(&x, &buf[index], len - index) < 0)
+ fail("append");
+ send_errno_result(ei_send(fd, &pid, x.buff, x.index));
+ ei_x_free(&x);
+}
+
+static void cmd_ei_send_funs(char* buf, int len)
+{
+ int index = 0, n;
+ long fd;
+ erlang_pid pid;
+ ei_x_buff x;
+ erlang_fun fun1, fun2;
+
+ if (ei_decode_long(buf, &index, &fd) < 0)
+ fail("expected long");
+ if (ei_decode_pid(buf, &index, &pid) < 0)
+ fail("expected pid (node)");
+ if (ei_decode_tuple_header(buf, &index, &n) < 0)
+ fail("expected tuple");
+ if (n != 2)
+ fail("expected tuple");
+ if (ei_decode_fun(buf, &index, &fun1) < 0)
+ fail("expected Fun1");
+ if (ei_decode_fun(buf, &index, &fun2) < 0)
+ fail("expected Fun2");
+ if (ei_x_new_with_version(&x) < 0)
+ fail("ei_x_new_with_version");
+ if (ei_x_encode_tuple_header(&x, 2) < 0)
+ fail("encode tuple header");
+ if (ei_x_encode_fun(&x, &fun1) < 0)
+ fail("encode fun1");
+ if (ei_x_encode_fun(&x, &fun2) < 0)
+ fail("encode fun2");
+ free_fun(&fun1);
+ free_fun(&fun2);
+ send_errno_result(ei_send(fd, &pid, x.buff, x.index));
+ ei_x_free(&x);
+}
+
+static void cmd_ei_reg_send(char* buf, int len)
+{
+ int index = 0;
+ long fd;
+ char reg_name[MAXATOMLEN];
+ erlang_pid pid;
+ ei_x_buff x;
+
+ if (ei_decode_long(buf, &index, &fd) < 0)
+ fail("expected long (fd)");
+ if (ei_decode_atom(buf, &index, reg_name) < 0)
+ fail("expected atom (reg name)");
+ if (ei_x_new_with_version(&x) < 0)
+ fail("ei_x_new_with_version");
+ if (ei_x_append_buf(&x, &buf[index], len - index) < 0)
+ fail("append");
+ send_errno_result(ei_reg_send(&ec, fd,
+ reg_name, x.buff, x.index));
+ ei_x_free(&x);
+}
+
+static void cmd_ei_rpc(char* buf, int len)
+{
+ int index = 0, n;
+ long fd;
+ erlang_pid pid;
+ ei_x_buff x, rpc_x;
+ int r;
+ char mod[MAXATOMLEN], func[MAXATOMLEN];
+
+#if 0 && defined(__WIN32__)
+ DebugBreak();
+#endif
+
+ if (ei_decode_long(buf, &index, &fd) < 0)
+ fail("expected long");
+ if (ei_decode_pid(buf, &index, &pid) < 0)
+ fail("expected pid (node)");
+ if (ei_decode_tuple_header(buf, &index, &n) < 0 && n < 2)
+ fail("expected tuple {module, function}");
+ if (ei_decode_atom(buf, &index, mod) < 0)
+ fail("expected atom (module)");
+ if (ei_decode_atom(buf, &index, func) < 0)
+ fail("expected atom (function)");
+ message("pid %s %d %d %d\n", pid.node, pid.num, pid.serial, pid.creation);
+ message("{%s, %s}\n", mod, func);
+ if (ei_x_new(&rpc_x) < 0)
+ fail("ei_x_new");
+ if (ei_rpc(&ec, fd, mod, func, &buf[index], len - index, &rpc_x) < 0)
+ fail("ei_rpc");
+ if (ei_x_new_with_version(&x) < 0)
+ fail("ei_x_new_with_version");
+ if (ei_x_append(&x, &rpc_x) < 0)
+ fail("append");
+ send_bin_term(&x);
+ /*send_errno_result(ei_send(&ec, fd, &pid, x.buff, x.index));*/
+ ei_x_free(&x);
+ ei_x_free(&rpc_x);
+}
+
+static void send_errno_result(int value)
+{
+ ei_x_buff x;
+ ei_x_new_with_version(&x);
+ ei_x_encode_tuple_header(&x, 2);
+ ei_x_encode_long(&x, value);
+ ei_x_encode_long(&x, erl_errno);
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/einode.c b/lib/erl_interface/test/ei_connect_SUITE_data/einode.c
new file mode 100644
index 0000000000..bafe8bd5bd
--- /dev/null
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/einode.c
@@ -0,0 +1,158 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/* to test multiple threads in ei */
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#ifdef __WIN32__
+#include <winsock2.h>
+#include <windows.h>
+#include <process.h>
+#else
+#ifndef VXWORKS
+#include <pthread.h>
+#endif
+#include <sys/socket.h>
+#endif
+
+#include "ei.h"
+
+#ifdef VXWORKS
+#define MAIN cnode
+#else
+#define MAIN main
+#endif
+
+/*
+ A small einode.
+ To be called from the test case ei_accept_SUITE:multi_thread
+ usage: einode <cookie> <n> <destnode>
+
+ - start threads 0..n-1
+ - in each thread
+ - connect to destnode
+ - send a message ("ei0".."ei<n-1>") to mth0..mth<n-1> on destnode
+ - shutdown gracefully
+*/
+
+static const char* cookie, * desthost;
+
+#ifndef SD_SEND
+#ifdef SHUTWR
+#define SD_SEND SHUT_WR
+#else
+#define SD_SEND 1
+#endif
+#endif
+
+#ifndef __WIN32__
+#define closesocket(fd) close(fd)
+#endif
+
+#ifdef __WIN32__
+static DWORD WINAPI
+#else
+static void*
+#endif
+ einode_thread(void* num)
+{
+ int n = (int)num;
+ ei_cnode ec;
+ char myname[100], destname[100];
+ int r, fd;
+
+ sprintf(myname, "ei%d", n);
+ sprintf(destname, "mth%d", n);
+ printf("thread %d (%s %s) connecting\n", n, myname, destname);
+ r = ei_connect_init(&ec, myname, cookie, 0);
+ fd = ei_connect(&ec, (char*)desthost);
+ if (r == 0 && fd >= 0) {
+ ei_x_buff x;
+ ei_x_new_with_version(&x);
+ ei_x_encode_string(&x, myname);
+ ei_reg_send(&ec, fd, destname, x.buff, x.index);
+ ei_x_free(&x);
+ //SleepEx(100);
+ shutdown(fd, SD_SEND);
+ closesocket(fd);
+ } else {
+ printf("coudn't connect fd %d r %d\n", fd, r); // DebugBreak();
+ }
+ printf("done thread %d\n", n);
+ return 0;
+}
+
+MAIN(int argc, char *argv[])
+{
+ int i, n, no_threads;
+#ifndef VXWORKS
+#ifdef __WIN32__
+ HANDLE threads[100];
+#else
+ pthread_t threads[100];
+#endif
+#endif
+
+ if (argc < 3)
+ exit(1);
+
+ cookie = argv[1];
+ n = atoi(argv[2]);
+ if (n > 100)
+ exit(2);
+ desthost = argv[3];
+#ifndef VXWORKS
+ no_threads = argv[4] != NULL && strcmp(argv[4], "nothreads") == 0;
+#else
+ no_threads = 1;
+#endif
+ for (i = 0; i < n; ++i) {
+ if (!no_threads) {
+#ifndef VXWORKS
+#ifdef __WIN32__
+ unsigned tid;
+ threads[i] = (HANDLE)_beginthreadex(NULL, 0, einode_thread,
+ (void*)i, 0, &tid);
+#else
+ pthread_create(&threads[i], NULL, einode_thread, (void*)i);
+#endif
+#else
+ ;
+#endif
+ } else
+ einode_thread((void*)i);
+ }
+ if (!no_threads)
+#ifndef VXWORKS
+ for (i = 0; i < n; ++i) {
+#ifdef __WIN32__
+ if (WaitForSingleObject(threads[i], INFINITE) != WAIT_OBJECT_0)
+#else
+ if (pthread_join(threads[i], NULL) != 0)
+#endif
+ printf("bad wait thread %d\n", i);
+ }
+#else
+ ;
+#endif
+ printf("ok\n");
+ return 0;
+}
diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl
new file mode 100644
index 0000000000..ea528728ab
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_SUITE.erl
@@ -0,0 +1,300 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_decode_SUITE).
+
+-include("test_server.hrl").
+-include("ei_decode_SUITE_data/ei_decode_test_cases.hrl").
+
+-export(
+ [
+ all/1,
+ test_ei_decode_long/1,
+ test_ei_decode_ulong/1,
+ test_ei_decode_longlong/1,
+ test_ei_decode_ulonglong/1,
+ test_ei_decode_char/1,
+ test_ei_decode_nonoptimal/1,
+ test_ei_decode_misc/1
+ ]).
+
+all(suite) ->
+ [
+ test_ei_decode_long,
+ test_ei_decode_ulong,
+ test_ei_decode_longlong,
+ test_ei_decode_ulonglong,
+ test_ei_decode_char,
+ test_ei_decode_nonoptimal,
+ test_ei_decode_misc
+ ].
+
+%% ---------------------------------------------------------------------------
+
+% NOTE: for historical reasons we don't pach as tight as we can,
+% we only fill 27 bits in 32 bit INTEGER_EXT
+
+
+%% ######################################################################## %%
+
+test_ei_decode_long(suite) -> [];
+test_ei_decode_long(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_long),
+ send_integers(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_decode_ulong(suite) -> [];
+test_ei_decode_ulong(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_ulong),
+ send_integers(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+% (*) In practical terms, other values may fit into the ext format
+% i32 is signed 32 bit on C side
+% u32 is unsigned 32 bit on C side
+
+%% ######################################################################## %%
+
+test_ei_decode_longlong(suite) -> [];
+test_ei_decode_longlong(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Skipped on VxWorks"};
+ _ ->
+ ?line P = runner:start(?test_ei_decode_longlong),
+ send_integers2(P),
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+
+%% ######################################################################## %%
+
+test_ei_decode_ulonglong(suite) -> [];
+test_ei_decode_ulonglong(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Skipped on VxWorks"};
+ _ ->
+ ?line P = runner:start(?test_ei_decode_ulonglong),
+ send_integers2(P),
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+
+%% ######################################################################## %%
+%% A "character" for us is an 8 bit integer, alwasy positive, i.e.
+%% it is unsigned.
+%% FIXME maybe the API should change to use "unsigned char" to be clear?!
+
+test_ei_decode_char(suite) -> [];
+test_ei_decode_char(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_char),
+
+ ?line send_term_as_binary(P,0),
+ ?line send_term_as_binary(P,16#7f),
+ ?line send_term_as_binary(P,16#ff),
+
+ ?line send_term_as_binary(P, []), % illegal type
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_decode_nonoptimal(suite) -> [];
+test_ei_decode_nonoptimal(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_nonoptimal),
+
+ send_non_optimal_pos(P), % decode_char
+ send_non_optimal(P), % decode_long
+ send_non_optimal_pos(P), % decode_ulong
+ case os:type() of
+ vxworks ->
+ ok;
+ _ ->
+ send_non_optimal(P), % decode_longlong
+ send_non_optimal_pos(P) % decode_ulonglong
+ end,
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+send_non_optimal(P) ->
+ send_non_optimal_pos(P),
+ send_non_optimal_neg(P).
+
+send_non_optimal_pos(P) ->
+ ?line send_raw(P, <<131,97,42>>),
+ ?line send_raw(P, <<131,98,42:32>>),
+ ?line send_raw(P, <<131,110,1,0,42>>),
+ ?line send_raw(P, <<131,110,2,0,42,0>>),
+ ?line send_raw(P, <<131,110,4,0,42,0,0,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,1,0,42>>),
+ ?line send_raw(P, <<131,111,0,0,0,2,0,42,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,3,0,42,0,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,6,0,42,0,0,0,0,0>>),
+ ok.
+
+send_non_optimal_neg(P) ->
+% ?line send_raw(P, <<131,97,-42>>),
+ ?line send_raw(P, <<131,98,-42:32>>),
+ ?line send_raw(P, <<131,110,1,1,42>>),
+ ?line send_raw(P, <<131,110,2,1,42,0>>),
+ ?line send_raw(P, <<131,110,4,1,42,0,0,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,1,1,42>>),
+ ?line send_raw(P, <<131,111,0,0,0,2,1,42,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,3,1,42,0,0>>),
+ ?line send_raw(P, <<131,111,0,0,0,6,1,42,0,0,0,0,0>>),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_decode_misc(suite) -> [];
+test_ei_decode_misc(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_misc),
+
+% ?line <<131>> = get_binaries(P),
+
+% ?line {term,F} = get_term(P),
+% ?line match_float(F, 0.0),
+% ?line {term,F} = get_term(P),
+% ?line match_float(F, 0.0),
+
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, -1.0),
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, -1.0),
+
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, 1.0),
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, 1.0),
+
+ ?line send_term_as_binary(P,false),
+ ?line send_term_as_binary(P,true),
+
+ ?line send_term_as_binary(P,foo),
+ ?line send_term_as_binary(P,''),
+ ?line send_term_as_binary(P,'������'),
+
+ ?line send_term_as_binary(P,"foo"),
+ ?line send_term_as_binary(P,""),
+ ?line send_term_as_binary(P,"������"),
+
+ ?line send_term_as_binary(P,<<"foo">>),
+ ?line send_term_as_binary(P,<<>>),
+ ?line send_term_as_binary(P,<<"������">>),
+
+% ?line send_term_as_binary(P,{}),
+% ?line send_term_as_binary(P,[]),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+send_term_as_binary(Port, Term) when is_port(Port) ->
+ Port ! {self(), {command, term_to_binary(Term)}}.
+
+send_raw(Port, Bin) when is_port(Port) ->
+ Port ! {self(), {command, Bin}}.
+
+
+send_integers(P) ->
+ ?line send_term_as_binary(P,0), % SMALL_INTEGER_EXT smallest
+ ?line send_term_as_binary(P,255), % SMALL_INTEGER_EXT largest
+ ?line send_term_as_binary(P,256), % INTEGER_EXT smallest pos (*)
+ ?line send_term_as_binary(P,-1), % INTEGER_EXT largest neg
+
+ ?line send_term_as_binary(P, 16#07ffffff), % INTEGER_EXT largest (28 bits)
+ ?line send_term_as_binary(P,-16#08000000), % INTEGER_EXT smallest
+ ?line send_term_as_binary(P, 16#08000000), % SMALL_BIG_EXT smallest pos(*)
+ ?line send_term_as_binary(P,-16#08000001), % SMALL_BIG_EXT largest neg (*)
+
+ ?line send_term_as_binary(P, 16#7fffffff), % SMALL_BIG_EXT largest i32
+ ?line send_term_as_binary(P,-16#80000000), % SMALL_BIG_EXT smallest i32
+
+ case erlang:system_info(wordsize) of
+ 4 ->
+ ?line send_term_as_binary(P, 16#80000000),% SMALL_BIG_EXT u32
+ ?line send_term_as_binary(P, 16#ffffffff),% SMALL_BIG_EXT largest u32
+
+ ?line send_term_as_binary(P, 16#7fffffffffff), % largest i48
+ ?line send_term_as_binary(P,-16#800000000000), % smallest i48
+ ?line send_term_as_binary(P, 16#ffffffffffff), % largest u48
+ ?line send_term_as_binary(P, 16#7fffffffffffffff), % largest i64
+ ?line send_term_as_binary(P,-16#8000000000000000), % smallest i64
+ ?line send_term_as_binary(P, 16#ffffffffffffffff); % largest u64
+ 8 ->
+ ?line send_term_as_binary(P, 16#8000000000000000),% SMALL_BIG_EXT u64
+ % SMALL_BIG_EXT largest u64
+ ?line send_term_as_binary(P, 16#ffffffffffffffff),
+ % largest i96
+ ?line send_term_as_binary(P, 16#7fffffffffffffffffffffff),
+ % smallest i96
+ ?line send_term_as_binary(P,-16#800000000000000000000000),
+ % largest u96
+ ?line send_term_as_binary(P, 16#ffffffffffffffffffffffff),
+ % largest i128
+ ?line send_term_as_binary(P, 16#7fffffffffffffffffffffffffffffff),
+ % smallest i128
+ ?line send_term_as_binary(P,-16#80000000000000000000000000000000),
+ % largest u128
+ ?line send_term_as_binary(P, 16#ffffffffffffffffffffffffffffffff)
+ end,
+ ?line send_term_as_binary(P, []), % illegal type
+ ok.
+
+send_integers2(P) ->
+ ?line send_term_as_binary(P,0), % SMALL_INTEGER_EXT smallest
+ ?line send_term_as_binary(P,255), % SMALL_INTEGER_EXT largest
+ ?line send_term_as_binary(P,256), % INTEGER_EXT smallest pos (*)
+ ?line send_term_as_binary(P,-1), % INTEGER_EXT largest neg
+
+ ?line send_term_as_binary(P, 16#07ffffff), % INTEGER_EXT largest (28 bits)
+ ?line send_term_as_binary(P,-16#08000000), % INTEGER_EXT smallest
+ ?line send_term_as_binary(P, 16#08000000), % SMALL_BIG_EXT smallest pos(*)
+ ?line send_term_as_binary(P,-16#08000001), % SMALL_BIG_EXT largest neg (*)
+
+ ?line send_term_as_binary(P, 16#7fffffff), % SMALL_BIG_EXT largest i32
+ ?line send_term_as_binary(P,-16#80000000), % SMALL_BIG_EXT smallest i32
+ ?line send_term_as_binary(P, 16#80000000),% SMALL_BIG_EXT u32
+ ?line send_term_as_binary(P, 16#ffffffff),% SMALL_BIG_EXT largest u32
+
+ ?line send_term_as_binary(P, 16#7fffffffffff), % largest i48
+ ?line send_term_as_binary(P,-16#800000000000), % smallest i48
+ ?line send_term_as_binary(P, 16#ffffffffffff), % largest u48
+ ?line send_term_as_binary(P, 16#7fffffffffffffff), % largest i64
+ ?line send_term_as_binary(P,-16#8000000000000000), % smallest i64
+ ?line send_term_as_binary(P, 16#ffffffffffffffff), % largest u64
+ ?line send_term_as_binary(P, []), % illegal type
+ ok.
diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..0791b54109
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_decode_test_decl.c: ei_decode_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_decode_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..76e55750c3
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_DECODE_OBJS = ei_decode_test@obj@ ei_decode_test_decl@obj@
+
+all: ei_decode_test@exe@
+
+clean:
+ $(RM) $(EI_DECODE_OBJS)
+ $(RM) ei_decode_test@exe@
+
+ei_decode_test@exe@: $(EI_DECODE_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_DECODE_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
new file mode 100644
index 0000000000..d81ea88437
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
@@ -0,0 +1,548 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#include "ei_runner.h"
+
+/*
+ * Purpose: Tests the ei_format() function.
+ * Author: Kent
+ */
+
+#ifdef VXWORKS
+#define MESSAGE_BACK(SIZE) \
+ message("err = %d, size2 = %d, expected size = %d", \
+ err, size1, SIZE);
+#else
+#define MESSAGE_BACK(SIZE) \
+ message("err = %d, size2 = %d, expected size = %d, long long val = %lld", \
+ err, size1, SIZE, (EI_LONGLONG)p);
+#endif
+
+#define EI_DECODE_2(FUNC,SIZE,TYPE,VAL) \
+ { \
+ TYPE p; \
+ char *buf; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " " #TYPE " should be " #VAL); \
+ buf = read_packet(NULL); \
+\
+ err = ei_ ## FUNC(buf+1, &size1, NULL); \
+ message("err = %d, size1 = %d, expected size = %d", \
+ err, size1, SIZE); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1 if NULL pointer"); \
+ } else { \
+ fail("returned non zero if NULL pointer"); \
+ } \
+ return; \
+ } \
+\
+ err = ei_ ## FUNC(buf+1, &size2, &p); \
+ MESSAGE_BACK(SIZE) \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (p != (TYPE)VAL) { \
+ fail("value is not correct"); \
+ return; \
+ } \
+\
+ if (size1 != size2) { \
+ fail("size with and without pointer differs"); \
+ return; \
+ } \
+\
+ if (size1 != SIZE) { \
+ fail("size of encoded data is incorrect"); \
+ return; \
+ } \
+ } \
+
+#define EI_DECODE_2_FAIL(FUNC,SIZE,TYPE,VAL) \
+ { \
+ TYPE p, saved_p; \
+ char *buf; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " " #TYPE " should fail"); \
+ memset(&p,'\0',sizeof(p)); \
+ saved_p = p; \
+ buf = read_packet(NULL); \
+\
+ err = ei_ ## FUNC(buf+1, &size1, NULL); \
+ message("err = %d, size1 = %d, expected size = %d", \
+ err, size1, SIZE); \
+ if (err != -1) { \
+ fail("should return -1 if NULL pointer"); \
+ return; \
+ } \
+\
+ err = ei_ ## FUNC(buf+1, &size2, &p); \
+ message("err = %d, size2 = %d, expected size = %d", \
+ err, size1, SIZE); \
+ if (err != -1) { \
+ fail("should return -1"); \
+ return; \
+ } \
+ if (p != saved_p) { \
+ fail("p argument was modified"); \
+ return; \
+ } \
+\
+ if (size1 != 0) { \
+ fail("size of encoded data should be 0 if NULL"); \
+ return; \
+ } \
+\
+ if (size2 != 0) { \
+ fail("size of encoded data should be 0"); \
+ return; \
+ } \
+ } \
+
+#define EI_DECODE_STRING(FUNC,SIZE,VAL) \
+ { \
+ char p[1024]; \
+ char *buf; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " should be " #VAL); \
+ buf = read_packet(NULL); \
+\
+ err = ei_ ## FUNC(buf+1, &size1, NULL); \
+ message("err = %d, size = %d, expected size = %d\n",err,size1,SIZE); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1 if NULL pointer"); \
+ } else { \
+ fail("returned non zero if NULL pointer"); \
+ } \
+ return; \
+ } \
+\
+ err = ei_ ## FUNC(buf+1, &size2, p); \
+ message("err = %d, size = %d, expected size = %d\n",err,size2,SIZE); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+\
+ if (strcmp(p,VAL) != 0) { \
+ fail("value is not correct"); \
+ return; \
+ } \
+\
+ if (size1 != size2) { \
+ fail("size with and without pointer differs"); \
+ return; \
+ } \
+\
+ if (size1 != SIZE) { \
+ fail("size of encoded data is incorrect"); \
+ return; \
+ } \
+ } \
+
+#define EI_DECODE_BIN(FUNC,SIZE,VAL,LEN) \
+ { \
+ char p[1024]; \
+ char *buf; \
+ long len; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " should be " #VAL); \
+ buf = read_packet(NULL); \
+ err = ei_ ## FUNC(buf+1, &size1, NULL, &len); \
+ message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\
+ err,size1,len,SIZE,LEN); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1 if NULL pointer"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+\
+ if (len != LEN) { \
+ fail("size is not correct"); \
+ return; \
+ } \
+\
+ err = ei_ ## FUNC(buf+1, &size2, p, &len); \
+ message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\
+ err,size2,len,SIZE,LEN); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1 if NULL pointer"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+\
+ if (len != LEN) { \
+ fail("size is not correct"); \
+ return; \
+ } \
+\
+ if (strncmp(p,VAL,LEN) != 0) { \
+ fail("value is not correct"); \
+ return; \
+ } \
+\
+ if (size1 != size2) { \
+ fail("size with and without pointer differs"); \
+ return; \
+ } \
+\
+ if (size1 != SIZE) { \
+ fail("size of encoded data is incorrect"); \
+ return; \
+ } \
+ } \
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_long)
+{
+ EI_DECODE_2 (decode_long, 2, long, 0);
+ EI_DECODE_2 (decode_long, 2, long, 255);
+ EI_DECODE_2 (decode_long, 5, long, 256);
+ EI_DECODE_2 (decode_long, 5, long, -1);
+
+ EI_DECODE_2 (decode_long, 5, long, 0x07ffffff);
+ EI_DECODE_2 (decode_long, 5, long, -0x08000000);
+ EI_DECODE_2 (decode_long, 7, long, 0x08000000);
+ EI_DECODE_2 (decode_long, 7, long, -0x08000001);
+
+ EI_DECODE_2 (decode_long, 7, long, 0x7fffffff);
+ EI_DECODE_2 (decode_long, 7, long, -ll(0x80000000)); /* Strange :-( */
+
+ EI_DECODE_2_FAIL(decode_long, 7, long, 0x80000000);
+ EI_DECODE_2_FAIL(decode_long, 7, long, 0xffffffff);
+
+ EI_DECODE_2_FAIL(decode_long, 9, long, ll(0x7fffffffffff));
+ EI_DECODE_2_FAIL(decode_long, 9, long, -ll(0x800000000000));
+ EI_DECODE_2_FAIL(decode_long, 9, long, ll(0xffffffffffff));
+ EI_DECODE_2_FAIL(decode_long, 11, long, ll(0x7fffffffffffffff));
+ EI_DECODE_2_FAIL(decode_long, 11, long, -ll(0x8000000000000000));
+ EI_DECODE_2_FAIL(decode_long, 11, long, ll(0xffffffffffffffff));
+
+ EI_DECODE_2_FAIL(decode_long, 1, long, 0); /* Illegal type sent */
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_ulong)
+{
+ EI_DECODE_2 (decode_ulong, 2, unsigned long, 0);
+ EI_DECODE_2 (decode_ulong, 2, unsigned long, 255);
+ EI_DECODE_2 (decode_ulong, 5, unsigned long, 256);
+ EI_DECODE_2_FAIL(decode_ulong, 5, unsigned long, -1);
+
+ EI_DECODE_2 (decode_ulong, 5, unsigned long, 0x07ffffff);
+ EI_DECODE_2_FAIL(decode_ulong, 5, unsigned long, -0x08000000);
+ EI_DECODE_2 (decode_ulong, 7, unsigned long, 0x08000000);
+ EI_DECODE_2_FAIL(decode_ulong, 7, unsigned long, -0x08000001);
+
+ EI_DECODE_2 (decode_ulong, 7, unsigned long, 0x7fffffff);
+ EI_DECODE_2_FAIL(decode_ulong, 7, unsigned long, -ll(0x80000000));
+
+ if (sizeof(long) > 4) {
+ EI_DECODE_2 (decode_ulong, 11, unsigned long, ll(0x8000000000000000));
+ EI_DECODE_2 (decode_ulong, 11, unsigned long, ll(0xffffffffffffffff));
+ } else {
+ EI_DECODE_2 (decode_ulong, 7, unsigned long, 0x80000000);
+ EI_DECODE_2 (decode_ulong, 7, unsigned long, 0xffffffff);
+ }
+
+ EI_DECODE_2_FAIL(decode_ulong, 9, unsigned long, ll(0x7fffffffffff));
+ EI_DECODE_2_FAIL(decode_ulong, 9, unsigned long, -ll(0x800000000000));
+ EI_DECODE_2_FAIL(decode_ulong, 9, unsigned long, ll(0xffffffffffff));
+ EI_DECODE_2_FAIL(decode_ulong, 11, unsigned long, ll(0x7fffffffffffffff));
+ EI_DECODE_2_FAIL(decode_ulong, 11, unsigned long, -ll(0x8000000000000000));
+ EI_DECODE_2_FAIL(decode_ulong, 11, unsigned long, ll(0xffffffffffffffff));
+
+ EI_DECODE_2_FAIL(decode_ulong, 1, unsigned long, 0); /* Illegal type */
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+
+TESTCASE(test_ei_decode_longlong)
+{
+#ifndef VXWORKS
+ EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 0);
+ EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 255);
+ EI_DECODE_2 (decode_longlong, 5, EI_LONGLONG, 256);
+ EI_DECODE_2 (decode_longlong, 5, EI_LONGLONG, -1);
+
+ EI_DECODE_2 (decode_longlong, 5, EI_LONGLONG, 0x07ffffff);
+ EI_DECODE_2 (decode_longlong, 5, EI_LONGLONG, -0x08000000);
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, 0x08000000);
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, -0x08000001);
+
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, 0x7fffffff);
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, -ll(0x80000000));
+
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, 0x80000000);
+ EI_DECODE_2 (decode_longlong, 7, EI_LONGLONG, 0xffffffff);
+
+ EI_DECODE_2 (decode_longlong, 9, EI_LONGLONG, ll(0x7fffffffffff));
+ EI_DECODE_2 (decode_longlong, 9, EI_LONGLONG, -ll(0x800000000000));
+ EI_DECODE_2 (decode_longlong, 9, EI_LONGLONG, ll(0xffffffffffff));
+ EI_DECODE_2 (decode_longlong, 11, EI_LONGLONG, ll(0x7fffffffffffffff));
+ EI_DECODE_2 (decode_longlong, 11, EI_LONGLONG, -ll(0x8000000000000000));
+ EI_DECODE_2_FAIL(decode_longlong, 11, EI_LONGLONG, ll(0xffffffffffffffff));
+
+ EI_DECODE_2_FAIL(decode_longlong, 1, EI_LONGLONG, 0); /* Illegal type */
+#endif
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_ulonglong)
+{
+#ifndef VXWORKS
+ EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 0);
+ EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 255);
+ EI_DECODE_2 (decode_ulonglong, 5, EI_ULONGLONG, 256);
+ EI_DECODE_2_FAIL(decode_ulonglong, 5, EI_ULONGLONG, -1);
+
+ EI_DECODE_2 (decode_ulonglong, 5, EI_ULONGLONG, 0x07ffffff);
+ EI_DECODE_2_FAIL(decode_ulonglong, 5, EI_ULONGLONG, -0x08000000);
+ EI_DECODE_2 (decode_ulonglong, 7, EI_ULONGLONG, 0x08000000);
+ EI_DECODE_2_FAIL(decode_ulonglong, 7, EI_ULONGLONG, -0x08000001);
+
+ EI_DECODE_2 (decode_ulonglong, 7, EI_ULONGLONG, 0x7fffffff);
+ EI_DECODE_2_FAIL(decode_ulonglong, 7, EI_ULONGLONG, -ll(0x80000000));
+
+ EI_DECODE_2 (decode_ulonglong, 7, EI_ULONGLONG, 0x80000000);
+ EI_DECODE_2 (decode_ulonglong, 7, EI_ULONGLONG, 0xffffffff);
+
+ EI_DECODE_2 (decode_ulonglong, 9, EI_ULONGLONG, ll(0x7fffffffffff));
+ EI_DECODE_2_FAIL(decode_ulonglong, 9, EI_ULONGLONG, -ll(0x800000000000));
+ EI_DECODE_2 (decode_ulonglong, 9, EI_ULONGLONG, ll(0xffffffffffff));
+ EI_DECODE_2 (decode_ulonglong,11, EI_ULONGLONG, ll(0x7fffffffffffffff));
+ EI_DECODE_2_FAIL(decode_ulonglong,11, EI_ULONGLONG, -ll(0x8000000000000000));
+ EI_DECODE_2 (decode_ulonglong,11, EI_ULONGLONG, ll(0xffffffffffffffff));
+
+ EI_DECODE_2_FAIL(decode_ulonglong, 1, EI_ULONGLONG, 0); /* Illegal type */
+#endif
+ report(1);
+}
+
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_char)
+{
+ EI_DECODE_2(decode_char, 2, char, 0);
+ EI_DECODE_2(decode_char, 2, char, 0x7f);
+ EI_DECODE_2(decode_char, 2, char, 0xff);
+
+ EI_DECODE_2_FAIL(decode_char, 1, char, 0); /* Illegal type */
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_nonoptimal)
+{
+ EI_DECODE_2(decode_char, 2, char, 42);
+ EI_DECODE_2(decode_char, 5, char, 42);
+ EI_DECODE_2(decode_char, 4, char, 42);
+ EI_DECODE_2(decode_char, 5, char, 42);
+ EI_DECODE_2(decode_char, 7, char, 42);
+ EI_DECODE_2(decode_char, 7, char, 42);
+ EI_DECODE_2(decode_char, 8, char, 42);
+ EI_DECODE_2(decode_char, 9, char, 42);
+ EI_DECODE_2(decode_char, 12, char, 42);
+
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+/* EI_DECODE_2(decode_char, char, -42); */
+
+ /* ---------------------------------------------------------------- */
+
+ EI_DECODE_2(decode_long, 2, long, 42);
+ EI_DECODE_2(decode_long, 5, long, 42);
+ EI_DECODE_2(decode_long, 4, long, 42);
+ EI_DECODE_2(decode_long, 5, long, 42);
+ EI_DECODE_2(decode_long, 7, long, 42);
+ EI_DECODE_2(decode_long, 7, long, 42);
+ EI_DECODE_2(decode_long, 8, long, 42);
+ EI_DECODE_2(decode_long, 9, long, 42);
+ EI_DECODE_2(decode_long, 12, long, 42);
+
+/* EI_DECODE_2(decode_long, 2, long, -42); */
+ EI_DECODE_2(decode_long, 5, long, -42);
+ EI_DECODE_2(decode_long, 4, long, -42);
+ EI_DECODE_2(decode_long, 5, long, -42);
+ EI_DECODE_2(decode_long, 7, long, -42);
+ EI_DECODE_2(decode_long, 7, long, -42);
+ EI_DECODE_2(decode_long, 8, long, -42);
+ EI_DECODE_2(decode_long, 9, long, -42);
+ EI_DECODE_2(decode_long, 12, long, -42);
+
+ /* ---------------------------------------------------------------- */
+
+ EI_DECODE_2(decode_ulong, 2, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 5, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 4, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 5, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 7, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 7, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 8, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 9, unsigned long, 42);
+ EI_DECODE_2(decode_ulong, 12, unsigned long, 42);
+
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+/* EI_DECODE_2(decode_ulong, unsigned long, -42); */
+
+ /* ---------------------------------------------------------------- */
+
+#ifndef VXWORKS
+
+ EI_DECODE_2(decode_longlong, 2, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 5, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 4, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 5, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 7, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 7, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 8, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 9, EI_LONGLONG, 42);
+ EI_DECODE_2(decode_longlong, 12, EI_LONGLONG, 42);
+
+/* EI_DECODE_2(decode_longlong, 2, EI_LONGLONG, -42); */
+ EI_DECODE_2(decode_longlong, 5, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 4, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 5, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 7, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 7, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 8, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 9, EI_LONGLONG, -42);
+ EI_DECODE_2(decode_longlong, 12, EI_LONGLONG, -42);
+
+ /* ---------------------------------------------------------------- */
+
+ EI_DECODE_2(decode_ulonglong, 2, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 5, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 4, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 5, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 7, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 7, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 8, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 9, EI_ULONGLONG, 42);
+ EI_DECODE_2(decode_ulonglong, 12, EI_ULONGLONG, 42);
+
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+/* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */
+
+#endif /* !VXWORKS */
+
+ /* ---------------------------------------------------------------- */
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_misc)
+{
+/*
+ EI_DECODE_0(decode_version);
+*/
+/*
+ EI_DECODE_2(decode_double, 0.0);
+ EI_DECODE_2(decode_double, -1.0);
+ EI_DECODE_2(decode_double, 1.0);
+*/
+ EI_DECODE_2(decode_boolean, 8, int, 0);
+ EI_DECODE_2(decode_boolean, 7, int, 1);
+
+ EI_DECODE_STRING(decode_atom, 6, "foo");
+ EI_DECODE_STRING(decode_atom, 3, "");
+ EI_DECODE_STRING(decode_atom, 9, "������");
+
+ EI_DECODE_STRING(decode_string, 6, "foo");
+ EI_DECODE_STRING(decode_string, 1, "");
+ EI_DECODE_STRING(decode_string, 9, "������");
+
+ EI_DECODE_BIN(decode_binary, 8, "foo", 3);
+ EI_DECODE_BIN(decode_binary, 5, "", 0);
+ EI_DECODE_BIN(decode_binary, 11, "������", 6);
+
+ /* FIXME check \0 in strings and atoms? */
+/*
+ EI_ENCODE_1(decode_tuple_header, 0);
+
+ EI_ENCODE_0(decode_empty_list);
+*/
+ report(1);
+}
+
+/* ******************************************************************** */
+
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
new file mode 100644
index 0000000000..c19c1d0887
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
@@ -0,0 +1,290 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_decode_encode_SUITE).
+
+-include("test_server.hrl").
+-include("ei_decode_encode_SUITE_data/ei_decode_encode_test_cases.hrl").
+
+-export(
+ [
+ all/1,
+ test_ei_decode_encode/1
+ ]).
+
+all(suite) ->
+ [
+ test_ei_decode_encode
+ ].
+
+%% ---------------------------------------------------------------------------
+
+% NOTE: these types have no meaning on the C side so we pass them
+% to C and back just to see they are the same.
+
+
+%% ######################################################################## %%
+
+test_ei_decode_encode(suite) -> [];
+test_ei_decode_encode(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_decode_encode),
+
+ Fun = fun (X) -> {X,true} end,
+ Pid = self(),
+ Port = case os:type() of
+ {win32,_} ->
+ open_port({spawn,"sort"},[]);
+ _ ->
+ open_port({spawn,"/bin/true"},[])
+ end,
+ Ref = make_ref(),
+ Trace = {1,2,3,self(),4}, % FIXME how to construct?!
+
+
+ BigSmallA = 1696192905348584855517250509684275447603964214606878827319923580493120589769459602596313014087329389174229999430092223701630077631205171572331191216670754029016160388576759960413039261647653627052707047,
+ BigSmallB = 43581177444506616087519351724629421082877485633442736512567383077022781906420535744195118099822189576169114064491200598595995538299156626345938812352676950427869649947439032133573270227067833308153431095,
+ BigSmallC = 52751775381034251994634567029696659541685100826881826508158083211003576763074162948462801435204697796532659535818017760528684167216110865807581759669824808936751316879636014972704885388116861127856231,
+
+ BigLargeA = 1 bsl 11111 + BigSmallA,
+ BigLargeB = 1 bsl 11112 + BigSmallB,
+ BigLargeC = BigSmallA * BigSmallB * BigSmallC * BigSmallA,
+
+ ?line send_rec(P, Fun),
+ ?line send_rec(P, Pid),
+ ?line send_rec(P, Port),
+ ?line send_rec(P, Ref),
+ ?line send_rec(P, Trace),
+
+ % bigs
+
+ ?line send_rec(P, BigSmallA),
+ ?line send_rec(P, BigSmallB),
+ ?line send_rec(P, BigSmallC),
+
+ ?line send_rec(P, BigLargeA),
+ ?line send_rec(P, BigLargeB),
+ ?line send_rec(P, BigLargeC),
+
+ %% Test large node containers...
+
+ ?line ThisNode = {node(), erlang:system_info(creation)},
+ ?line TXPid = mk_pid(ThisNode, 32767, 8191),
+ ?line TXPort = mk_port(ThisNode, 268435455),
+ ?line TXRef = mk_ref(ThisNode, [262143, 4294967295, 4294967295]),
+
+ ?line OtherNode = {gurka@sallad, 2},
+ ?line OXPid = mk_pid(OtherNode, 32767, 8191),
+ ?line OXPort = mk_port(OtherNode, 268435455),
+ ?line OXRef = mk_ref(OtherNode, [262143, 4294967295, 4294967295]),
+
+ ?line send_rec(P, TXPid),
+ ?line send_rec(P, TXPort),
+ ?line send_rec(P, TXRef),
+ ?line send_rec(P, OXPid),
+ ?line send_rec(P, OXPort),
+ ?line send_rec(P, OXRef),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+% We read two packets for each test, the ei_decode_encode and ei_x_decode_encode version....
+
+send_rec(P, Term) when is_port(P) ->
+ ?t:format("Testing: ~p~n", [Term]),
+ P ! {self(), {command, term_to_binary(Term)}},
+ {_B,Term} = get_buf_and_term(P).
+
+
+
+get_buf_and_term(P) ->
+ B = get_binaries(P),
+ case B of
+ <<131>> ->
+ io:format("(got single magic, no content)\n",[]),
+ {B,'$$magic$$'};
+ <<131,_>> ->
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got magic)\n",[B,T]),
+ {B,T};
+ _ ->
+ B1 = list_to_binary([131,B]), % No magic, add
+ T = binary_to_term(B1),
+ io:format("~w\n~w\n(got no magic)\n",[B,T]),
+ {B,T}
+ end.
+
+
+get_binaries(P) ->
+ B1 = get_binary(P),
+ B2 = get_binary(P),
+ B1 = B2.
+
+get_binary(P) ->
+ case runner:get_term(P) of
+ {bytes,L} ->
+ B = list_to_binary(L),
+ io:format("~w\n",[L]),
+% For strange reasons <<131>> show up as <>....
+% io:format("~w\n",[B]),
+ B;
+ Other ->
+ Other
+ end.
+
+%%
+
+% We use our own get_term()
+
+get_term(P) ->
+ case runner:get_term(P) of
+ {bytes,[131]} ->
+ io:format("(got single magic, no content)\n",[]),
+ '$$magic$$';
+ {bytes,[131,L]} ->
+ B = list_to_binary(L),
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got magic)\n",[L,T]),
+ T;
+ {bytes,L} ->
+ B = list_to_binary([131,L]),
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got no magic)\n",[L,T]),
+ T;
+ Other ->
+ Other
+ end.
+
+%%
+%% Node container constructor functions
+%%
+
+-define(VERSION_MAGIC, 131).
+
+-define(ATOM_EXT, 100).
+-define(REFERENCE_EXT, 101).
+-define(PORT_EXT, 102).
+-define(PID_EXT, 103).
+-define(NEW_REFERENCE_EXT, 114).
+
+uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 ->
+ [(Uint bsr 24) band 16#ff,
+ (Uint bsr 16) band 16#ff,
+ (Uint bsr 8) band 16#ff,
+ Uint band 16#ff];
+uint32_be(Uint) ->
+ exit({badarg, uint32_be, [Uint]}).
+
+
+uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 ->
+ [(Uint bsr 8) band 16#ff,
+ Uint band 16#ff];
+uint16_be(Uint) ->
+ exit({badarg, uint16_be, [Uint]}).
+
+uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 ->
+ Uint band 16#ff;
+uint8(Uint) ->
+ exit({badarg, uint8, [Uint]}).
+
+
+
+mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) ->
+ mk_pid({atom_to_list(NodeName), Creation}, Number, Serial);
+mk_pid({NodeName, Creation}, Number, Serial) ->
+ case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
+ ?PID_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint32_be(Serial),
+ uint8(Creation)])) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
+ end.
+
+mk_port({NodeName, Creation}, Number) when is_atom(NodeName) ->
+ mk_port({atom_to_list(NodeName), Creation}, Number);
+mk_port({NodeName, Creation}, Number) ->
+ case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
+ ?PORT_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Port when is_port(Port) ->
+ Port;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_port, [{NodeName, Creation}, Number]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
+ end.
+
+mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName),
+ is_integer(Creation),
+ is_list(Numbers) ->
+ mk_ref({atom_to_list(NodeName), Creation}, Numbers);
+mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName),
+ is_integer(Creation),
+ is_integer(Number) ->
+ case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
+ ?REFERENCE_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
+ end;
+mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName),
+ is_integer(Creation),
+ is_list(Numbers) ->
+ case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
+ ?NEW_REFERENCE_EXT,
+ uint16_be(length(Numbers)),
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint8(Creation),
+ lists:map(fun (N) ->
+ uint32_be(N)
+ end,
+ Numbers)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
+ end.
+
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..168a21b10e
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_decode_encode_test_decl.c: ei_decode_encode_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_decode_encode_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..d43e834558
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_DECODE_ENCODE_OBJS = ei_decode_encode_test@obj@ ei_decode_encode_test_decl@obj@
+
+all: ei_decode_encode_test@exe@
+
+clean:
+ $(RM) $(EI_DECODE_ENCODE_OBJS)
+ $(RM) ei_decode_encode_test@exe@
+
+ei_decode_encode_test@exe@: $(EI_DECODE_ENCODE_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_DECODE_ENCODE_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c
new file mode 100644
index 0000000000..406f02ecfb
--- /dev/null
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c
@@ -0,0 +1,229 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#include "ei_runner.h"
+
+/*
+ * Purpose: Read pids, funs and others without real meaning on the C side
+ * and pass it back to Erlang to test that it is still the same.
+ * Author: [email protected]
+ */
+
+#define EI_DECODE_ENCODE(FUNC,TYPE) \
+ { \
+ char *buf; \
+ char buf2[1024]; \
+ TYPE p; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int size3 = 0; \
+ int err; \
+ ei_x_buff arg; \
+\
+ message("ei_decode_" #FUNC ", arg is type " #TYPE); \
+ buf = read_packet(NULL); \
+ err = ei_decode_ ## FUNC(buf+1, &size1, &p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("decode returned non zero but not -1"); \
+ } else { \
+ fail("decode returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 < 1) { \
+ fail("size is < 1"); \
+ return; \
+ } \
+\
+ message("ei_encode_" #FUNC " buf is NULL, arg is type " #TYPE); \
+ err = ei_encode_ ## FUNC(NULL, &size2, &p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("size calculation returned non zero but not -1"); \
+ return; \
+ } else { \
+ fail("size calculation returned non zero"); \
+ return; \
+ } \
+ } \
+ if (size1 != size2) { \
+ message("size1 = %d, size2 = %d\n",size1,size2); \
+ fail("decode and encode size differs when buf is NULL"); \
+ return; \
+ } \
+ message("ei_encode_" #FUNC ", arg is type " #TYPE); \
+ err = ei_encode_ ## FUNC(buf2, &size3, &p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 != size3) { \
+ message("size1 = %d, size2 = %d\n",size1,size3); \
+ fail("decode and encode size differs"); \
+ return; \
+ } \
+ send_buffer(buf2, size1); \
+\
+ message("ei_x_encode_" #FUNC ", arg is type " #TYPE); \
+ ei_x_new(&arg); \
+ err = ei_x_encode_ ## FUNC(&arg, &p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ if (arg.index < 1) { \
+ fail("size is < 1"); \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ send_buffer(arg.buff, arg.index); \
+ ei_x_free(&arg); \
+ }
+
+#define EI_DECODE_ENCODE_BIG(FUNC,TYPE) \
+ { \
+ char *buf; \
+ char buf2[2048]; \
+ TYPE *p; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int size3 = 0; \
+ int err, index = 0, len, type; \
+ ei_x_buff arg; \
+\
+ message("ei_decode_" #FUNC ", arg is type " #TYPE); \
+ buf = read_packet(NULL); \
+ ei_get_type(buf+1, &index, &type, &len); \
+ p = ei_alloc_big(len); \
+ err = ei_decode_ ## FUNC(buf+1, &size1, p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("decode returned non zero but not -1"); \
+ } else { \
+ fail("decode returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 < 1) { \
+ fail("size is < 1"); \
+ return; \
+ } \
+\
+ message("ei_encode_" #FUNC " buf is NULL, arg is type " #TYPE); \
+ err = ei_encode_ ## FUNC(NULL, &size2, p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("size calculation returned non zero but not -1"); \
+ return; \
+ } else { \
+ fail("size calculation returned non zero"); \
+ return; \
+ } \
+ } \
+ if (size1 != size2) { \
+ message("size1 = %d, size2 = %d\n",size1,size2); \
+ fail("decode and encode size differs when buf is NULL"); \
+ return; \
+ } \
+ message("ei_encode_" #FUNC ", arg is type " #TYPE); \
+ err = ei_encode_ ## FUNC(buf2, &size3, p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 != size3) { \
+ message("size1 = %d, size2 = %d\n",size1,size3); \
+ fail("decode and encode size differs"); \
+ return; \
+ } \
+ send_buffer(buf2, size1); \
+\
+ message("ei_x_encode_" #FUNC ", arg is type " #TYPE); \
+ ei_x_new(&arg); \
+ err = ei_x_encode_ ## FUNC(&arg, p); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ if (arg.index < 1) { \
+ fail("size is < 1"); \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ send_buffer(arg.buff, arg.index); \
+ ei_x_free(&arg); \
+ ei_free_big(p); \
+ }
+
+
+
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_decode_encode)
+{
+ EI_DECODE_ENCODE(fun , erlang_fun);
+ EI_DECODE_ENCODE(pid , erlang_pid);
+ EI_DECODE_ENCODE(port , erlang_port);
+ EI_DECODE_ENCODE(ref , erlang_ref);
+ EI_DECODE_ENCODE(trace, erlang_trace);
+
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+ EI_DECODE_ENCODE_BIG(big , erlang_big);
+
+ /* Test large node containers... */
+ EI_DECODE_ENCODE(pid , erlang_pid);
+ EI_DECODE_ENCODE(port , erlang_port);
+ EI_DECODE_ENCODE(ref , erlang_ref);
+ EI_DECODE_ENCODE(pid , erlang_pid);
+ EI_DECODE_ENCODE(port , erlang_port);
+ EI_DECODE_ENCODE(ref , erlang_ref);
+
+ report(1);
+}
+
+/* ******************************************************************** */
diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl
new file mode 100644
index 0000000000..fb790eb7c3
--- /dev/null
+++ b/lib/erl_interface/test/ei_encode_SUITE.erl
@@ -0,0 +1,315 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_encode_SUITE).
+
+-include("test_server.hrl").
+-include("ei_encode_SUITE_data/ei_encode_test_cases.hrl").
+
+-export(
+ [
+ all/1,
+ test_ei_encode_long/1,
+ test_ei_encode_ulong/1,
+ test_ei_encode_longlong/1,
+ test_ei_encode_ulonglong/1,
+ test_ei_encode_char/1,
+ test_ei_encode_misc/1,
+ test_ei_encode_fails/1
+ ]).
+
+all(suite) ->
+ [
+ test_ei_encode_long,
+ test_ei_encode_ulong,
+ test_ei_encode_longlong,
+ test_ei_encode_ulonglong,
+ test_ei_encode_char,
+ test_ei_encode_misc,
+ test_ei_encode_fails
+ ].
+
+%% ---------------------------------------------------------------------------
+
+% NOTE: for historical reasons we don't pach as tight as we can,
+% we only fill 27 bits in 32 bit INTEGER_EXT
+
+
+%% ######################################################################## %%
+
+test_ei_encode_long(suite) -> [];
+test_ei_encode_long(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_encode_long),
+
+ ?line {<<97,0>> ,0} = get_buf_and_term(P),
+ ?line {<<97,255>> ,255} = get_buf_and_term(P),
+ ?line {<<98,256:32/big-signed-integer>>,256} = get_buf_and_term(P),
+ ?line {<<98,-1:32/big-signed-integer>> ,-1} = get_buf_and_term(P),
+
+ ?line {<<98, 16#07ffffff:32/big-signed-integer>>, 16#07ffffff} = get_buf_and_term(P),
+ ?line {<<98,-16#08000000:32/big-signed-integer>>,-16#08000000} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,8>> , 16#08000000} = get_buf_and_term(P),
+ ?line {<<110,4,1, 1,0,0,8>> ,-16#08000001} = get_buf_and_term(P),
+
+ ?line {<<110,4,0, 255,255,255,127>> , 16#7fffffff} = get_buf_and_term(P),
+ ?line {<<110,4,1, 0,0,0,128>> ,-16#80000000} = get_buf_and_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_encode_ulong(suite) -> [];
+test_ei_encode_ulong(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_encode_ulong),
+
+ ?line {<<97,0>> ,0} = get_buf_and_term(P),
+ ?line {<<97,255>> ,255} = get_buf_and_term(P),
+ ?line {<<98,256:32/big-unsigned-integer>>,256} = get_buf_and_term(P),
+
+ ?line {<<98, 16#07ffffff:32/big-signed-integer>>,16#07ffffff} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,8>> ,16#08000000} = get_buf_and_term(P),
+
+ ?line {<<110,4,0, 255,255,255,127>> ,16#7fffffff} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,128>> ,16#80000000} = get_buf_and_term(P),
+ ?line {<<110,4,0, 255,255,255,255>> ,16#ffffffff} = get_buf_and_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_encode_longlong(suite) -> [];
+test_ei_encode_longlong(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Skipped on VxWorks"};
+ _ ->
+ ?line P = runner:start(?test_ei_encode_longlong),
+
+ ?line {<<97,0>> ,0} = get_buf_and_term(P),
+ ?line {<<97,255>> ,255} = get_buf_and_term(P),
+ ?line {<<98,256:32/big-signed-integer>>,256} = get_buf_and_term(P),
+ ?line {<<98,-1:32/big-signed-integer>> ,-1} = get_buf_and_term(P),
+
+ ?line {<<98, 16#07ffffff:32/big-signed-integer>>, 16#07ffffff} = get_buf_and_term(P),
+ ?line {<<98,-16#08000000:32/big-signed-integer>>,-16#08000000} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,8>> , 16#08000000} = get_buf_and_term(P),
+ ?line {<<110,4,1, 1,0,0,8>> ,-16#08000001} = get_buf_and_term(P),
+
+ ?line {<<110,4,0, 255,255,255,127>> , 16#7fffffff} = get_buf_and_term(P),
+ ?line {<<110,4,1, 0,0,0,128>> ,-16#80000000} = get_buf_and_term(P),
+ ?line {<<110,6,0, 255,255,255,255,255,127>> , 16#7fffffffffff} = get_buf_and_term(P),
+ ?line {<<110,6,1, 0,0,0,0,0,128>> ,-16#800000000000} = get_buf_and_term(P),
+ ?line {<<110,8,0, 255,255,255,255,255,255,255,127>>,16#7fffffffffffffff} = get_buf_and_term(P),
+ ?line {<<110,8,1, 0,0,0,0,0,0,0,128>> ,-16#8000000000000000} = get_buf_and_term(P),
+
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+
+%% ######################################################################## %%
+
+test_ei_encode_ulonglong(suite) -> [];
+test_ei_encode_ulonglong(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Skipped on VxWorks"};
+ _ ->
+ ?line P = runner:start(?test_ei_encode_ulonglong),
+
+ ?line {<<97,0>> ,0} = get_buf_and_term(P),
+ ?line {<<97,255>> ,255} = get_buf_and_term(P),
+ ?line {<<98,256:32/big-unsigned-integer>>,256} = get_buf_and_term(P),
+
+ ?line {<<98, 16#07ffffff:32/big-signed-integer>>,16#07ffffff} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,8>> ,16#08000000} = get_buf_and_term(P),
+
+ ?line {<<110,4,0, 255,255,255,127>> ,16#7fffffff} = get_buf_and_term(P),
+ ?line {<<110,4,0, 0,0,0,128>> ,16#80000000} = get_buf_and_term(P),
+ ?line {<<110,4,0, 255,255,255,255>> ,16#ffffffff} = get_buf_and_term(P),
+ ?line {<<110,6,0, 255,255,255,255,255,255>>,16#ffffffffffff} = get_buf_and_term(P),
+ ?line {<<110,8,0, 255,255,255,255,255,255,255,255>>,16#ffffffffffffffff} = get_buf_and_term(P),
+
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+
+%% ######################################################################## %%
+%% A "character" for us is an 8 bit integer, alwasy positive, i.e.
+%% it is unsigned.
+%% FIXME maybe the API should change to use "unsigned char" to be clear?!
+
+test_ei_encode_char(suite) -> [];
+test_ei_encode_char(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_encode_char),
+
+ ?line {<<97, 0>>,0} = get_buf_and_term(P),
+ ?line {<<97,127>>,16#7f} = get_buf_and_term(P),
+ ?line {<<97,255>>,16#ff} = get_buf_and_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_encode_misc(suite) -> [];
+test_ei_encode_misc(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_encode_misc),
+
+ ?line <<131>> = get_binaries(P),
+
+% ?line {term,F} = get_term(P),
+% ?line match_float(F, 0.0),
+% ?line {term,F} = get_term(P),
+% ?line match_float(F, 0.0),
+
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, -1.0),
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, -1.0),
+
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, 1.0),
+% ?line {term,F} = get_term(P),
+% ?line true = match_float(F, 1.0),
+
+ ?line {<<100,0,5,"false">>,false} = get_buf_and_term(P),
+ ?line {<<100,0,4,"true">> ,true} = get_buf_and_term(P),
+ ?line {<<100,0,4,"true">> ,true} = get_buf_and_term(P),
+ ?line {<<100,0,4,"true">> ,true} = get_buf_and_term(P),
+
+ ?line {<<100,0,3,"foo">>,foo} = get_buf_and_term(P),
+ ?line {<<100,0,3,"foo">>,foo} = get_buf_and_term(P),
+ ?line {<<100,0,0,"">>,''} = get_buf_and_term(P),
+ ?line {<<100,0,0,"">>,''} = get_buf_and_term(P),
+ ?line {<<100,0,6,"������">>,'������'} = get_buf_and_term(P),
+ ?line {<<100,0,6,"������">>,'������'} = get_buf_and_term(P),
+
+ ?line {<<107,0,3,"foo">>,"foo"} = get_buf_and_term(P),
+ ?line {<<107,0,3,"foo">>,"foo"} = get_buf_and_term(P),
+ ?line {<<106>>,""} = get_buf_and_term(P),
+ ?line {<<106>>,""} = get_buf_and_term(P),
+ ?line {<<107,0,6,"������">>,"������"} = get_buf_and_term(P),
+ ?line {<<107,0,6,"������">>,"������"} = get_buf_and_term(P),
+
+ ?line {<<109,0,0,0,3,"foo">>,<<"foo">>} = get_buf_and_term(P),
+ ?line {<<109,0,0,0,0,"">>,<<>>} = get_buf_and_term(P),
+ ?line {<<109,0,0,0,6,"������">>,<<"������">>} = get_buf_and_term(P),
+
+ ?line {<<104,0>>,{}} = get_buf_and_term(P), % Tuple header for {}
+ ?line {<<106>>,[]} = get_buf_and_term(P), % Empty list []
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+test_ei_encode_fails(suite) -> [];
+test_ei_encode_fails(Config) when is_list(Config) ->
+ ?line P = runner:start(?test_ei_encode_fails),
+
+ ?line XAtom = list_to_atom(lists:duplicate(255, $x)),
+ ?line YAtom = list_to_atom(lists:duplicate(255, $y)),
+
+ ?line XAtom = get_term(P),
+ ?line XAtom = get_term(P),
+ ?line YAtom = get_term(P),
+ ?line YAtom = get_term(P),
+
+ ?line {{{{}}}} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% ######################################################################## %%
+
+% We read two packets for each test, the ei_encode and ei_x_encode version....
+
+get_buf_and_term(P) ->
+ B = get_binaries(P),
+ case B of
+ <<131>> ->
+ io:format("(got single magic, no content)\n",[]),
+ {B,'$$magic$$'};
+ <<131,_>> ->
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got magic)\n",[B,T]),
+ {B,T};
+ _ ->
+ B1 = list_to_binary([131,B]), % No magic, add
+ T = binary_to_term(B1),
+ io:format("~w\n~w\n(got no magic)\n",[B,T]),
+ {B,T}
+ end.
+
+
+get_binaries(P) ->
+ B1 = get_binary(P),
+ B2 = get_binary(P),
+ B1 = B2.
+
+get_binary(P) ->
+ case runner:get_term(P) of
+ {bytes,L} ->
+ B = list_to_binary(L),
+ io:format("~w\n",[L]),
+% For strange reasons <<131>> show up as <>....
+% io:format("~w\n",[B]),
+ B;
+ Other ->
+ Other
+ end.
+
+%%
+
+% We use our own get_term()
+
+get_term(P) ->
+ case runner:get_term(P) of
+ {bytes,[131]} ->
+ io:format("(got single magic, no content)\n",[]),
+ '$$magic$$';
+ {bytes,[131,L]} ->
+ B = list_to_binary(L),
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got magic)\n",[L,T]),
+ T;
+ {bytes,L} ->
+ B = list_to_binary([131,L]),
+ T = binary_to_term(B),
+ io:format("~w\n~w\n(got no magic)\n",[L,T]),
+ T;
+ Other ->
+ Other
+ end.
+
+%%
+
+match_float(F, Match) when is_float(F), F > Match*0.99, F < Match*1.01 ->
+ true.
+
diff --git a/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..19a6f4c0aa
--- /dev/null
+++ b/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_encode_test_decl.c: ei_encode_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_encode_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..f2a2c40615
--- /dev/null
+++ b/lib/erl_interface/test/ei_encode_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_ENCODE_OBJS = ei_encode_test@obj@ ei_encode_test_decl@obj@
+
+all: ei_encode_test@exe@
+
+clean:
+ $(RM) $(EI_ENCODE_OBJS)
+ $(RM) ei_encode_test@exe@
+
+ei_encode_test@exe@: $(EI_ENCODE_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_ENCODE_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c
new file mode 100644
index 0000000000..f8de0b7878
--- /dev/null
+++ b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c
@@ -0,0 +1,466 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#include "ei_runner.h"
+
+/*
+ * Purpose: Tests the ei_format() function.
+ * Author: Kent
+ */
+
+#define EI_ENCODE_0(FUNC) \
+ { \
+ char buf[1024]; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " encoded as "); \
+ err = ei_ ## FUNC(NULL, &size1); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("size calculation returned non zero but not -1"); \
+ return; \
+ } else { \
+ fail("size calculation returned non zero"); \
+ return; \
+ } \
+ } \
+ err = ei_ ## FUNC(buf, &size2); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 != size2) { \
+ fail("size differs when arg is NULL or buf"); \
+ return; \
+ } \
+ if (size1 < 1) { \
+ fail("size is < 1"); \
+ return; \
+ } \
+ send_buffer(buf, size1); \
+ } \
+ { \
+ ei_x_buff arg; \
+ int err; \
+ message("ei_x_" #FUNC " encoded as "); \
+ ei_x_new(&arg); \
+ err = ei_x_ ## FUNC(&arg); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ if (arg.index < 1) { \
+ fail("size is < 1"); \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ send_buffer(arg.buff, arg.index); \
+ ei_x_free(&arg); \
+ }
+
+#define EI_ENCODE_1(FUNC,ARG) \
+ { \
+ char buf[1024]; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " " #ARG " encoded as "); \
+ err = ei_ ## FUNC(NULL, &size1, ARG); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("size calculation returned non zero but not -1"); \
+ return; \
+ } else { \
+ fail("size calculation returned non zero"); \
+ return; \
+ } \
+ } \
+ err = ei_ ## FUNC(buf, &size2, ARG); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 != size2) { \
+ fail("size differs when arg is NULL or buf"); \
+ return; \
+ } \
+ if (size1 < 1) { \
+ fail("size is < 1"); \
+ return; \
+ } \
+ send_buffer(buf, size1); \
+ } \
+ { \
+ ei_x_buff arg; \
+ int err; \
+ message("ei_x_" #FUNC " " #ARG " encoded as "); \
+ ei_x_new(&arg); \
+ err = ei_x_ ## FUNC(&arg, ARG); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ if (arg.index < 1) { \
+ fail("size is < 1"); \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ send_buffer(arg.buff, arg.index); \
+ ei_x_free(&arg); \
+ }
+
+#define EI_ENCODE_2(FUNC,ARG1,ARG2) \
+ { \
+ char buf[1024]; \
+ int size1 = 0; \
+ int size2 = 0; \
+ int err; \
+ message("ei_" #FUNC " " #ARG1 " " #ARG2 " encoded as "); \
+ err = ei_ ## FUNC(NULL, &size1, ARG1, ARG2); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("size calculation returned non zero but not -1"); \
+ return; \
+ } else { \
+ fail("size calculation returned non zero"); \
+ return; \
+ } \
+ } \
+ err = ei_ ## FUNC(buf, &size2, ARG1, ARG2); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ return; \
+ } \
+ if (size1 != size2) { \
+ fail("size differs when arg is NULL or buf"); \
+ return; \
+ } \
+ if (size1 < 1) { \
+ fail("size is < 1"); \
+ return; \
+ } \
+ send_buffer(buf, size1); \
+ } \
+ { \
+ ei_x_buff arg; \
+ int err; \
+ message("ei_x_" #FUNC " " #ARG1 " " #ARG2 " encoded as "); \
+ ei_x_new(&arg); \
+ err = ei_x_ ## FUNC(&arg, ARG1, ARG2); \
+ if (err != 0) { \
+ if (err != -1) { \
+ fail("returned non zero but not -1"); \
+ } else { \
+ fail("returned non zero"); \
+ } \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ if (arg.index < 1) { \
+ fail("size is < 1"); \
+ ei_x_free(&arg); \
+ return; \
+ } \
+ send_buffer(arg.buff, arg.index); \
+ ei_x_free(&arg); \
+ }
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_long)
+{
+ EI_ENCODE_1(encode_long, 0);
+
+ EI_ENCODE_1(encode_long, 255);
+
+ EI_ENCODE_1(encode_long, 256);
+
+ EI_ENCODE_1(encode_long, -1);
+
+ EI_ENCODE_1(encode_long, 0x07ffffff);
+
+ EI_ENCODE_1(encode_long, -ll(0x08000000));
+
+ EI_ENCODE_1(encode_long, 0x07ffffff+1);
+
+ EI_ENCODE_1(encode_long, -ll(0x08000000)-1);
+
+ EI_ENCODE_1(encode_long, 0x7fffffff);
+
+ EI_ENCODE_1(encode_long, -ll(0x80000000));
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_ulong)
+{
+ EI_ENCODE_1(encode_ulong, 0);
+
+ EI_ENCODE_1(encode_ulong, 255);
+
+ EI_ENCODE_1(encode_ulong, 256);
+
+ EI_ENCODE_1(encode_ulong, 0x07ffffff);
+
+ EI_ENCODE_1(encode_ulong, 0x07ffffff+1);
+
+ EI_ENCODE_1(encode_ulong, 0x7fffffff);
+
+ EI_ENCODE_1(encode_ulong, 0x80000000);
+
+ EI_ENCODE_1(encode_ulong, 0xffffffff);
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+
+TESTCASE(test_ei_encode_longlong)
+{
+
+#ifndef VXWORKS
+
+ EI_ENCODE_1(encode_longlong, 0);
+
+ EI_ENCODE_1(encode_longlong, 255);
+
+ EI_ENCODE_1(encode_longlong, 256);
+
+ EI_ENCODE_1(encode_longlong, -1);
+
+ EI_ENCODE_1(encode_longlong, 0x07ffffff);
+
+ EI_ENCODE_1(encode_longlong, -ll(0x08000000));
+
+ EI_ENCODE_1(encode_longlong, 0x07ffffff+1);
+
+ EI_ENCODE_1(encode_longlong, -ll(0x08000000)-1);
+
+ EI_ENCODE_1(encode_longlong, 0x7fffffff);
+
+ EI_ENCODE_1(encode_longlong, -ll(0x80000000));
+
+ EI_ENCODE_1(encode_longlong, ll(0x7fffffffffff));
+
+ EI_ENCODE_1(encode_longlong, -ll(0x800000000000));
+
+ EI_ENCODE_1(encode_longlong, ll(0x7fffffffffffffff));
+
+ EI_ENCODE_1(encode_longlong, -ll(0x8000000000000000));
+
+#endif /* !VXWORKS */
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_ulonglong)
+{
+
+#ifndef VXWORKS
+
+ EI_ENCODE_1(encode_ulonglong, 0);
+
+ EI_ENCODE_1(encode_ulonglong, 255);
+
+ EI_ENCODE_1(encode_ulonglong, 256);
+
+ EI_ENCODE_1(encode_ulonglong, 0x07ffffff);
+
+ EI_ENCODE_1(encode_ulonglong, 0x07ffffff+1);
+
+ EI_ENCODE_1(encode_ulonglong, 0x7fffffff);
+
+ EI_ENCODE_1(encode_ulonglong, 0x80000000);
+
+ EI_ENCODE_1(encode_ulonglong, 0xffffffff);
+
+ EI_ENCODE_1(encode_ulonglong, ll(0xffffffffffff));
+
+ EI_ENCODE_1(encode_ulonglong, ll(0xffffffffffffffff));
+
+#endif /* !VXWORKS */
+
+ report(1);
+}
+
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_char)
+{
+ EI_ENCODE_1(encode_char, 0);
+
+ EI_ENCODE_1(encode_char, 0x7f);
+
+ EI_ENCODE_1(encode_char, 0xff);
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_misc)
+{
+ EI_ENCODE_0(encode_version);
+/*
+ EI_ENCODE_1(encode_double, 0.0);
+
+ EI_ENCODE_1(encode_double, -1.0);
+
+ EI_ENCODE_1(encode_double, 1.0);
+*/
+ EI_ENCODE_1(encode_boolean, 0) /* Only case it should be false */;
+
+ EI_ENCODE_1(encode_boolean, 1);
+
+ EI_ENCODE_1(encode_boolean, 42);
+
+ EI_ENCODE_1(encode_boolean, -1);
+
+ EI_ENCODE_1(encode_atom, "foo");
+ EI_ENCODE_2(encode_atom_len, "foo", 3);
+
+ EI_ENCODE_1(encode_atom, "");
+ EI_ENCODE_2(encode_atom_len, "", 0);
+
+ EI_ENCODE_1(encode_atom, "������");
+ EI_ENCODE_2(encode_atom_len, "������", 6);
+
+ EI_ENCODE_1(encode_string, "foo");
+ EI_ENCODE_2(encode_string_len, "foo", 3);
+
+ EI_ENCODE_1(encode_string, "");
+ EI_ENCODE_2(encode_string_len, "", 0);
+
+ EI_ENCODE_1(encode_string, "������");
+ EI_ENCODE_2(encode_string_len, "������", 6);
+
+ EI_ENCODE_2(encode_binary, "foo", 3);
+ EI_ENCODE_2(encode_binary, "", 0);
+ EI_ENCODE_2(encode_binary, "������", 6);
+
+ /* FIXME check \0 in strings and atoms */
+
+ EI_ENCODE_1(encode_tuple_header, 0);
+
+ EI_ENCODE_0(encode_empty_list);
+
+ report(1);
+}
+
+/* ******************************************************************** */
+
+TESTCASE(test_ei_encode_fails)
+{
+ char buf[1024];
+ int index;
+
+ /* FIXME the ei_x versions are not tested */
+
+ index = 0;
+ if (ei_encode_atom(buf, &index, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") != 0) {
+ fail("could not encode atom with 255 chars");
+ }
+ message("Encoding atom with 255 chars, encoded %d",index);
+ if (index != 255+3) {
+ fail("encoded with incorrect size");
+ }
+ send_buffer(buf, index);
+
+ index = 0;
+ if (ei_encode_atom_len(buf, &index, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx", 255) != 0) {
+ fail("could not encode atom with 255 chars");
+ }
+ message("Encoding atom with 255 chars, encoded %d",index);
+ if (index != 255+3) {
+ fail("encoded with incorrect size");
+ }
+ send_buffer(buf, index);
+
+ index = 0;
+ if (ei_encode_atom(buf, &index, "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy") != 0) {
+ fail("could not encode atom with 256 chars, truncated to 255");
+ }
+ message("Encoding atom with 256 chars, encoded %d",index);
+ if (index != 255+3) {
+ fail("did not truncate at 255 chars");
+ }
+ send_buffer(buf, index);
+
+ index = 0;
+ if (ei_encode_atom_len(buf, &index, "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy", 256) != 0) {
+ fail("could not encode atom with 256 chars, truncated to 255");
+ }
+ message("Encoding atom with 256 chars, encoded %d",index);
+ if (index != 255+3) {
+ fail("did not truncate at 255 chars");
+ }
+ send_buffer(buf, index);
+
+ /* ---------------------------------------------------------------------- */
+
+ index = 0;
+ if (ei_encode_tuple_header(buf, &index, 1) != 0) {
+ fail("could not create tuple header arity 1, take 1");
+ }
+ if (ei_encode_tuple_header(buf, &index, 1) != 0) {
+ fail("could not create tuple header arity 1, take 2");
+ }
+ if (ei_encode_tuple_header(buf, &index, 1) != 0) {
+ fail("could not create tuple header arity 1, take 3");
+ }
+ if (ei_encode_tuple_header(buf, &index, 0) != 0) {
+ fail("could not create tuple header arity 0");
+ }
+ send_buffer(buf, index);
+
+ report(1);
+}
diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl
new file mode 100644
index 0000000000..7871f07ae9
--- /dev/null
+++ b/lib/erl_interface/test/ei_format_SUITE.erl
@@ -0,0 +1,161 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_format_SUITE).
+
+-include("test_server.hrl").
+-include("ei_format_SUITE_data/ei_format_test_cases.hrl").
+
+-export([
+ format_wo_ver/1,
+ all/1,
+ atoms/1,
+ tuples/1,
+ lists/1
+ ]).
+
+-import(runner, [get_term/1]).
+
+%% This test suite test the erl_format() function.
+%% It uses the port program "ei_format_test".
+
+all(suite) -> [
+ format_wo_ver,
+ atoms,
+ tuples,
+ lists
+ ].
+
+%% Tests formatting various atoms.
+
+atoms(suite) -> [];
+atoms(Config) when is_list(Config) ->
+ ?line P = runner:start(?atoms),
+
+ ?line {term, ''} = get_term(P),
+ ?line {term, 'a'} = get_term(P),
+ ?line {term, 'A'} = get_term(P),
+ ?line {term, 'abc'} = get_term(P),
+ ?line {term, 'Abc'} = get_term(P),
+ ?line {term, 'ab@c'} = get_term(P),
+ ?line {term, 'The rain in Spain stays mainly in the plains'} =
+ get_term(P),
+
+ ?line {term, a} = get_term(P),
+ ?line {term, ab} = get_term(P),
+ ?line {term, abc} = get_term(P),
+ ?line {term, ab@c} = get_term(P),
+ ?line {term, abcdefghijklmnopq} = get_term(P),
+
+ ?line {term, ''} = get_term(P),
+ ?line {term, 'a'} = get_term(P),
+ ?line {term, 'A'} = get_term(P),
+ ?line {term, 'abc'} = get_term(P),
+ ?line {term, 'Abc'} = get_term(P),
+ ?line {term, 'ab@c'} = get_term(P),
+ ?line {term, 'The rain in Spain stays mainly in the plains'} =
+ get_term(P),
+
+ ?line {term, a} = get_term(P),
+ ?line {term, ab} = get_term(P),
+ ?line {term, abc} = get_term(P),
+ ?line {term, ab@c} = get_term(P),
+ ?line {term, ' abcdefghijklmnopq '} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various tuples
+
+tuples(suite) -> [];
+tuples(Config) when is_list(Config) ->
+ ?line P = runner:start(?tuples),
+
+ ?line {term, {}} = get_term(P),
+ ?line {term, {a}} = get_term(P),
+ ?line {term, {a, b}} = get_term(P),
+ ?line {term, {a, b, c}} = get_term(P),
+ ?line {term, {1}} = get_term(P),
+ ?line {term, {[]}} = get_term(P),
+ ?line {term, {[], []}} = get_term(P),
+ ?line {term, {[], a, b, c}} = get_term(P),
+ ?line {term, {[], a, [], b, c}} = get_term(P),
+ ?line {term, {[], a, '', b, c}} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various lists
+
+lists(suite) -> [];
+lists(Config) when is_list(Config) ->
+ ?line P = runner:start(?lists),
+
+ ?line {term, []} = get_term(P),
+ ?line {term, [a]} = get_term(P),
+ ?line {term, [a, b]} = get_term(P),
+ ?line {term, [a, b, c]} = get_term(P),
+ ?line {term, [1]} = get_term(P),
+ ?line {term, [[]]} = get_term(P),
+ ?line {term, [[], []]} = get_term(P),
+ ?line {term, [[], a, b, c]} = get_term(P),
+ ?line {term, [[], a, [], b, c]} = get_term(P),
+ ?line {term, [[], a, '', b, c]} = get_term(P),
+ ?line {term, [[x, 2], [y, 3], [z, 4]]}= get_term(P),
+ ?line {term, [{a,b},{c,d}]}= get_term(P),
+%% ?line {term, [{name, 'Madonna'}, {age, 21}, {data, [{addr, "E-street", 42}]}]} =
+%% get_term(P),
+
+ ?line {term, [{pi, F1}, {'cos(70)', F2}]} = get_term(P),
+ %% don't match floats directly
+ true= abs(3.1415-F1) < 0.01,
+ true= abs(0.34202-F2) < 0.01,
+
+ ?line {term, [[pi, F3], ['cos(70)', F4]]} = get_term(P),
+ true= abs(3.1415-F3) < 0.01,
+ true= abs(0.34202-F4) < 0.01,
+
+
+%% ?line {term, [[pi, 3.1415], [], ["cos(70)", 0.34202]]} = get_term(P),
+ ?line {term, [-1]} = get_term(P),
+ ?line {term, "hejsan"} = get_term(P),
+
+
+ ?line Str1 = lists:duplicate(65535,$A),
+ ?line Str2 = lists:duplicate(65536,$A),
+ ?line {term,Str1} = get_term(P),
+ ?line {term,Str2} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+format_wo_ver(suite) -> [];
+format_wo_ver(Config) when is_list(Config) ->
+ ?line P = runner:start(?format_wo_ver),
+
+ ?line {term, [{a, "b"}, {c, 10}]} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_format_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..1247ce08c7
--- /dev/null
+++ b/lib/erl_interface/test/ei_format_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_format_test_decl.c: ei_format_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_format_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_format_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..73d51794e9
--- /dev/null
+++ b/lib/erl_interface/test/ei_format_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_FORMAT_OBJS = ei_format_test@obj@ ei_format_test_decl@obj@
+
+all: ei_format_test@exe@
+
+clean:
+ $(RM) $(EI_FORMAT_OBJS)
+ $(RM) ei_format_test@exe@
+
+ei_format_test@exe@: $(EI_FORMAT_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_FORMAT_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
new file mode 100644
index 0000000000..a969ded3dc
--- /dev/null
+++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
@@ -0,0 +1,184 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#include "ei_runner.h"
+
+/*
+ * Purpose: Tests the ei_format() function.
+ * Author: Jakob
+ */
+
+static void
+send_format2(char* format, char* p)
+{
+ ei_x_buff x;
+ ei_x_new(&x);
+ ei_x_format(&x, format, p);
+ send_bin_term(&x);
+ free(x.buff);
+}
+
+static void
+send_format(char* format)
+{
+ send_format2(format, NULL);
+}
+
+TESTCASE(atoms)
+{
+ send_format("''");
+ send_format("'a'");
+ send_format("'A'");
+ send_format("'abc'");
+ send_format("'Abc'");
+ send_format("'ab@c'");
+ send_format("'The rain in Spain stays mainly in the plains'");
+
+ send_format("a");
+ send_format("ab");
+ send_format("abc");
+ send_format("ab@c");
+ send_format(" abcdefghijklmnopq ");
+
+ send_format2("~a", "");
+ send_format2("~a", "a");
+ send_format2("~a", "A");
+ send_format2("~a", "abc");
+ send_format2("~a", "Abc");
+ send_format2("~a", "ab@c");
+ send_format2("~a", "The rain in Spain stays mainly in the plains");
+
+ send_format2("~a", "a");
+ send_format2("~a", "ab");
+ send_format2("~a", "abc");
+ send_format2("~a","ab@c");
+ send_format2("~a", " abcdefghijklmnopq ");
+
+
+ report(1);
+}
+
+TESTCASE(tuples)
+{
+ send_format("{}");
+ send_format("{a}");
+ send_format("{a, b}");
+ send_format("{a, b, c}");
+ send_format("{1}");
+ send_format("{[]}");
+ send_format("{[], []}");
+ send_format("{[], a, b, c}");
+ send_format("{[], a, [], b, c}");
+ send_format("{[], a, '', b, c}");
+
+ report(1);
+}
+
+
+
+TESTCASE(lists)
+{
+/* FIXME cases to add?
+ ETERM* a;
+ ETERM* b;
+ ETERM* c;
+*/
+ ei_x_buff x;
+ static char str[65537];
+
+ send_format("[]");
+ send_format("[a]");
+ send_format("[a, b]");
+ send_format("[a, b, c]");
+ send_format("[1]");
+ send_format("[[]]");
+ send_format("[[], []]");
+ send_format("[[], a, b, c]");
+ send_format("[[], a, [], b, c]");
+ send_format("[[], a, '', b, c]");
+ send_format("[[x, 2], [y, 3], [z, 4]]");
+ send_format("[{a,b},{c,d}]"); /* OTP-4777 */
+
+ ei_x_new(&x);
+/*
+ b = erl_format("[{addr, ~s, ~i}]", "E-street", 42);
+ a = ei_format(x, "[{name, ~a}, {age, ~i}, {data, ~w}]", "Madonna", 21, b);
+ send_bin_term(a);
+ erl_free_term(b);*/
+ ei_x_format(&x, "[{pi, ~f}, {'cos(70)', ~f}]", (float)3.1415, (float)0.34202);
+ send_bin_term(&x);
+ x.index = 0; /* otherwise it'll send the previous term again */
+ ei_x_format(&x, "[[pi, ~d], ['cos(70)', ~d]]", 3.1415, 0.34202);
+ send_bin_term(&x);
+
+/* a = erl_mk_float(3.1415);
+ b = erl_mk_float(0.34202);
+ send_bin_term(ei_format("[[pi, ~w], ['cos(70)', ~w]]", a, b));
+ erl_free_term(a);
+ erl_free_term(b);
+
+ a = erl_mk_float(3.1415);
+ b = erl_mk_float(0.34202);
+ c = erl_mk_empty_list();
+ send_bin_term(ei_format("[[~a, ~w], ~w, [~s, ~w]]", "pi", a, c, "cos(70)", b));
+ erl_free_term(a);
+ erl_free_term(b);
+ erl_free_term(c);
+*/
+ x.index = 0; /* otherwise it'll send the previous term again */
+ ei_x_format(&x, "[~i]", -1);
+ send_bin_term(&x);
+
+ x.index = 0;
+ ei_x_format(&x, "~s","hejsan");
+ send_bin_term(&x);
+
+ memset(str,'A',65535);
+ str[65535] = '\0';
+ str[65536] = '\0';
+ x.index = 0;
+ ei_x_format(&x, "~s",str);
+ send_bin_term(&x);
+ str[65535] = 'A';
+ x.index = 0;
+ ei_x_format(&x, "~s",str);
+ send_bin_term(&x);
+
+
+ free(x.buff);
+ report(1);
+}
+
+TESTCASE(format_wo_ver) {
+/* OTP-6795
+ * make example with format_wo_ver
+ */
+ ei_x_buff x;
+
+ ei_x_new (&x);
+ ei_x_format(&x, "[{~a,~s},{~a,~i}]", "a", "b", "c", 10);
+ send_bin_term(&x);
+
+ free(x.buff);
+ report(1);
+}
diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl
new file mode 100644
index 0000000000..a0f15338c6
--- /dev/null
+++ b/lib/erl_interface/test/ei_print_SUITE.erl
@@ -0,0 +1,142 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_print_SUITE).
+
+-include("test_server.hrl").
+-include("ei_print_SUITE_data/ei_print_test_cases.hrl").
+
+-export([all/1, atoms/1, tuples/1, lists/1, strings/1]).
+
+-import(runner, [get_term/1]).
+
+%% This test suite test the ei_print() function.
+%% It uses the port program "ei_format_test".
+
+all(suite) -> [atoms, tuples, lists, strings].
+
+%% Tests formatting various atoms.
+
+atoms(suite) -> [];
+atoms(Config) when is_list(Config) ->
+ ?line P = runner:start(?atoms),
+
+ ?line {term, "''"} = get_term(P),
+ ?line {term, "a"} = get_term(P),
+ ?line {term, "'A'"} = get_term(P),
+ ?line {term, "abc"} = get_term(P),
+ ?line {term, "'Abc'"} = get_term(P),
+ ?line {term, "ab@c"} = get_term(P),
+ ?line {term, "'The rain in Spain stays mainly in the plains'"} =
+ get_term(P),
+
+ ?line {term, "a"} = get_term(P),
+ ?line {term, "ab"} = get_term(P),
+ ?line {term, "abc"} = get_term(P),
+ ?line {term, "ab@c"} = get_term(P),
+ ?line {term, "abcdefghijklmnopq"} = get_term(P),
+
+ ?line {term, "''"} = get_term(P),
+ ?line {term, "a"} = get_term(P),
+ ?line {term, "'A'"} = get_term(P),
+ ?line {term, "abc"} = get_term(P),
+ ?line {term, "'Abc'"} = get_term(P),
+ ?line {term, "ab@c"} = get_term(P),
+ ?line {term, "'The rain in Spain stays mainly in the plains'"} =
+ get_term(P),
+
+ ?line {term, "a"} = get_term(P),
+ ?line {term, "ab"} = get_term(P),
+ ?line {term, "abc"} = get_term(P),
+ ?line {term, "ab@c"} = get_term(P),
+ ?line {term, "' abcdefghijklmnopq '"} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various tuples
+
+tuples(suite) -> [];
+tuples(Config) when is_list(Config) ->
+ ?line P = runner:start(?tuples),
+
+ ?line {term, "{}"} = get_term(P),
+ ?line {term, "{a}"} = get_term(P),
+ ?line {term, "{a, b}"} = get_term(P),
+ ?line {term, "{a, b, c}"} = get_term(P),
+ ?line {term, "{1}"} = get_term(P),
+ ?line {term, "{[]}"} = get_term(P),
+ ?line {term, "{[], []}"} = get_term(P),
+ ?line {term, "{[], a, b, c}"} = get_term(P),
+ ?line {term, "{[], a, [], b, c}"} = get_term(P),
+ ?line {term, "{[], a, '', b, c}"} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various lists
+
+lists(suite) -> [];
+lists(Config) when is_list(Config) ->
+ ?line P = runner:start(?lists),
+
+ ?line {term, "[]"} = get_term(P),
+ ?line {term, "[a]"} = get_term(P),
+ ?line {term, "[a, b]"} = get_term(P),
+ ?line {term, "[a, b, c]"} = get_term(P),
+ ?line {term, "[1]"} = get_term(P),
+ ?line {term, "[[]]"} = get_term(P),
+ ?line {term, "[[], []]"} = get_term(P),
+ ?line {term, "[[], a, b, c]"} = get_term(P),
+ ?line {term, "[[], a, [], b, c]"} = get_term(P),
+ ?line {term, "[[], a, '', b, c]"} = get_term(P),
+ ?line {term, "[[x, 2], [y, 3], [z, 4]]"}= get_term(P),
+
+%% ?line {term, "[{name, 'Madonna'}, {age, 21}, {data, [{addr, "E-street", 42}]}]"} =
+%% get_term(P),
+ %% kanske regexp i st�llet?
+ ?line {term, "[{pi, 3.141500}, {'cos(70)', 0.342020}]"} = get_term(P),
+ ?line {term, "[[pi, 3.141500], ['cos(70)', 0.342020]]"} = get_term(P),
+
+ ?line {term, "[-1]"} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+strings(suite) -> [];
+strings(Config) when is_list(Config) ->
+ ?line P = runner:start(?strings),
+
+ ?line {term, "\"\\n\""} = get_term(P),
+ ?line {term, "\"\\r\\n\""} = get_term(P),
+ ?line {term, "\"a\""} = get_term(P),
+ ?line {term, "\"A\""} = get_term(P),
+ ?line {term, "\"0\""} = get_term(P),
+ ?line {term, "\"9\""} = get_term(P),
+ ?line {term, "\"The rain in Spain stays mainly in the plains\""} = get_term(P),
+ ?line {term, "\" abcdefghijklmnopq \""} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
diff --git a/lib/erl_interface/test/ei_print_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_print_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..e36d4364dc
--- /dev/null
+++ b/lib/erl_interface/test/ei_print_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_print_test_decl.c: ei_print_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_print_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_print_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_print_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..6eec4b1990
--- /dev/null
+++ b/lib/erl_interface/test/ei_print_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_PRINT_OBJS = ei_print_test@obj@ ei_print_test_decl@obj@
+
+all: ei_print_test@exe@
+
+clean:
+ $(RM) $(EI_PRINT_OBJS)
+ $(RM) ei_print_test@exe@
+
+ei_print_test@exe@: $(EI_PRINT_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_PRINT_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c
new file mode 100644
index 0000000000..cc9b8048ca
--- /dev/null
+++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c
@@ -0,0 +1,175 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "ei_runner.h"
+
+/*
+ * Purpose: Tests the ei_print() function.
+ * Author: Jakob
+ */
+
+static void
+send_printed3(char* format, char* p1, char* p2, int fl)
+{
+ char* b = NULL;
+ char fn[100], * tmp = getenv("temp");
+ FILE* f;
+ int n, index = 0, ver;
+ ei_x_buff x;
+
+ ei_x_new(&x);
+ if (fl) {
+ ei_x_format(&x, format, *(float*)p1, *(float*)p2);
+ } else {
+ ei_x_format(&x, format, p1, p2);
+ }
+#ifdef VXWORKS
+ tmp = ".";
+#else
+ if (tmp == NULL) tmp = "/tmp";
+#endif
+ strcpy(fn, tmp);
+ strcat(fn, "/ei_print_test.txt");
+ f = fopen(fn, "w+");
+ ei_decode_version(x.buff, &index, &ver);
+ n = ei_print_term(f, x.buff, &index);
+ fseek(f, 0, SEEK_SET);
+ b = malloc(n+1);
+ fread(b, 1, n, f);
+ b[n] = '\0';
+ fclose(f);
+ x.index = 0;
+ ei_x_format(&x, "~s", b);
+ send_bin_term(&x);
+ free(b);
+ ei_x_free(&x);
+}
+
+static void
+send_printed(char* format)
+{
+ send_printed3(format, NULL, NULL, 0);
+}
+
+static void
+send_printed2(char* format, char* p)
+{
+ send_printed3(format, p, NULL, 0);
+}
+
+static void send_printed3f(char* format, float f1, float f2)
+{
+ send_printed3(format, (char*)&f1, (char*)&f2, 1);
+}
+
+TESTCASE(atoms)
+{
+ send_printed("''");
+ send_printed("'a'");
+ send_printed("'A'");
+ send_printed("'abc'");
+ send_printed("'Abc'");
+ send_printed("'ab@c'");
+ send_printed("'The rain in Spain stays mainly in the plains'");
+
+ send_printed("a");
+ send_printed("ab");
+ send_printed("abc");
+ send_printed("ab@c");
+ send_printed(" abcdefghijklmnopq ");
+
+ send_printed2("~a", "");
+ send_printed2("~a", "a");
+ send_printed2("~a", "A");
+ send_printed2("~a", "abc");
+ send_printed2("~a", "Abc");
+ send_printed2("~a", "ab@c");
+ send_printed2("~a", "The rain in Spain stays mainly in the plains");
+
+ send_printed2("~a", "a");
+ send_printed2("~a", "ab");
+ send_printed2("~a", "abc");
+ send_printed2("~a","ab@c");
+ send_printed2("~a", " abcdefghijklmnopq ");
+
+
+ report(1);
+}
+
+TESTCASE(tuples)
+{
+ send_printed("{}");
+ send_printed("{a}");
+ send_printed("{a, b}");
+ send_printed("{a, b, c}");
+ send_printed("{1}");
+ send_printed("{[]}");
+ send_printed("{[], []}");
+ send_printed("{[], a, b, c}");
+ send_printed("{[], a, [], b, c}");
+ send_printed("{[], a, '', b, c}");
+
+ report(1);
+}
+
+
+
+TESTCASE(lists)
+{
+ ei_x_buff x;
+
+ send_printed("[]");
+ send_printed("[a]");
+ send_printed("[a, b]");
+ send_printed("[a, b, c]");
+ send_printed("[1]");
+ send_printed("[[]]");
+ send_printed("[[], []]");
+ send_printed("[[], a, b, c]");
+ send_printed("[[], a, [], b, c]");
+ send_printed("[[], a, '', b, c]");
+ send_printed("[[x, 2], [y, 3], [z, 4]]");
+
+ /* more tests needed */
+ send_printed3f("[{pi, ~f}, {'cos(70)', ~f}]",
+ (float)3.1415, (float)0.34202);
+ send_printed3f("[[pi, ~f], ['cos(70)', ~f]]",
+ (float)3.1415, (float)0.34202);
+
+ send_printed2("[~i]", (char*)-1);
+ report(1);
+}
+
+TESTCASE(strings)
+{
+ ei_x_buff x;
+
+ send_printed("\"\n\"");
+ send_printed("\"\r\n\"");
+ send_printed("\"a\"");
+ send_printed("\"A\"");
+ send_printed("\"0\"");
+ send_printed("\"9\"");
+ send_printed("\"The rain in Spain stays mainly in the plains\"");
+ send_printed("\" abcdefghijklmnopq \"");
+
+ report(1);
+}
+
+
diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl
new file mode 100644
index 0000000000..0c211aa148
--- /dev/null
+++ b/lib/erl_interface/test/ei_tmo_SUITE.erl
@@ -0,0 +1,666 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ei_tmo_SUITE).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/inet.hrl").
+-include("ei_tmo_SUITE_data/ei_tmo_test_cases.hrl").
+
+-define(dummy_host,test01).
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2,
+ framework_check/1, ei_accept_tmo/1, ei_connect_tmo/1, ei_send_tmo/1,
+ ei_recv_tmo/1]).
+
+all(suite) -> [framework_check,ei_accept_tmo,ei_connect_tmo,
+ ei_send_tmo,ei_recv_tmo].
+
+init_per_testcase(_Case, Config) ->
+ Dog = ?t:timetrap(?t:minutes(1)),
+ % test if platform is vxworks_simso
+ ?line {_,Host} = split(node()),
+ Bool = case atom_to_list(Host) of
+ [$v,$x,$s,$i,$m | _] -> true;
+ _ -> false
+ end,
+ [{vxsim,Bool},{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+framework_check(doc) ->
+ ["Check the framework."];
+framework_check(suite) ->
+ [];
+framework_check(Config) when is_list(Config) ->
+ %%dbg:tracer(),
+ %%dbg:p(self()),
+ ?line P = runner:start(?framework_check),
+ ?line runner:send_term(P,{hello,world}),
+ ?line {term, {hello,world}} = runner:get_term(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+ei_recv_tmo(doc) ->
+ ["Check recv with timeouts."];
+ei_recv_tmo(suite) ->
+ [];
+ei_recv_tmo(Config) when is_list(Config) ->
+ ?line do_one_recv(c_node_recv_tmo_1),
+ ?line do_one_recv_failure(c_node_recv_tmo_2),
+ ok.
+
+
+do_one_recv(CNode) ->
+ ?line {_,Host} = split(node()),
+ ?line P1 = runner:start(?recv_tmo),
+ ?line runner:send_term(P1,{CNode,
+ erlang:get_cookie(),
+ node()}),
+ ?line {term, X} = runner:get_term(P1, 10000),
+ ?line true = is_integer(X),
+ ?line CNode1 = join(CNode,Host),
+ ?line Term1 = {hej,[hopp,{i,[lingon,"skogen"]}]},
+ ?line {test,CNode1} ! Term1,
+ ?line {term, Term1} = runner:get_term(P1, 10000),
+ ?line runner:recv_eot(P1).
+
+do_one_recv_failure(CNode) ->
+ ?line P1 = runner:start(?recv_tmo),
+ ?line runner:send_term(P1,{CNode,
+ erlang:get_cookie(),
+ node()}),
+ ?line {term, X} = runner:get_term(P1, 10000),
+ ?line true = is_integer(X),
+ ?line {term, {Ret,ETimedout,ETimedout}} = runner:get_term(P1, 10000),
+ ?line true = (Ret < 0),
+ ?line runner:recv_eot(P1).
+
+
+ei_send_tmo(doc) ->
+ ["Check send with timeouts."];
+ei_send_tmo(suite) ->
+ [];
+ei_send_tmo(Config) when is_list(Config) ->
+ %dbg:tracer(),
+ %dbg:p(self()),
+ VxSim = ?config(vxsim, Config),
+ ?line register(ei_send_tmo_1,self()),
+ ?line do_one_send(self(),c_node_send_tmo_1),
+ ?line do_one_send(ei_send_tmo_1,c_node_send_tmo_2),
+ ?line do_one_send_failure(self(),cccc1,c_nod_send_tmo_3,VxSim),
+ ?line do_one_send_failure(ei_send_tmo_1,cccc2,c_nod_send_tmo_4,VxSim),
+ ok.
+
+
+do_one_send(From,CNode) ->
+ ?line {_,Host} = split(node()),
+ ?line P1 = runner:start(?send_tmo),
+ ?line runner:send_term(P1,{CNode,
+ erlang:get_cookie(),
+ node()}),
+ ?line {term, X} = runner:get_term(P1, 10000),
+ ?line true = is_integer(X),
+ ?line CNode1 = join(CNode,Host),
+ ?line Term1 = {hej,[hopp,{i,[lingon,"skogen"]}]},
+ ?line {test,CNode1} ! {From,1,Term1},
+ ?line ok = receive
+ Term1 ->
+ ok
+ after 2000 ->
+ error
+ end,
+ ?line {term, 0} = runner:get_term(P1, 10000),
+ ?line runner:recv_eot(P1).
+
+do_one_send_failure(From,FakeName,CName,VxSim) ->
+ ?line {_,Host} = split(node()),
+ ?line OurName = join(FakeName,Host),
+ ?line Node = join(CName,Host),
+ ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of
+ {ok, Socket} ->
+ ?line Socket;
+ Else ->
+ ?line exit(Else)
+ end,
+ ?line EpmdSocket = register(OurName, LSocket, 1, 5),
+ ?line P3 = runner:start(?send_tmo),
+ ?line Cookie = kaksmula_som_ingen_bryr_sig_om,
+ ?line runner:send_term(P3,{CName,
+ Cookie,
+ OurName}),
+ ?line SocketB = case gen_tcp:accept(LSocket) of
+ {ok, Socket1} ->
+ ?line Socket1;
+ Else2 ->
+ ?line exit(Else2)
+ end,
+ ?line {hidden,Node,5} = recv_name(SocketB), % See 1)
+ ?line send_status(SocketB, ok),
+ ?line MyChallengeB = gen_challenge(),
+ ?line send_challenge(SocketB, OurName, MyChallengeB, 5),
+ ?line HisChallengeB = recv_challenge_reply(
+ SocketB,
+ MyChallengeB,
+ Cookie),
+ ?line DigestB = gen_digest(HisChallengeB,Cookie),
+ ?line send_challenge_ack(SocketB, DigestB),
+ ?line inet:setopts(SocketB, [{active, false},
+ {packet, 4}]),
+ ?line {term, X} = runner:get_term(P3, 10000),
+ ?line true = is_integer(X),
+ ?line Message = [112,term_to_binary({6,self(),'',test}),
+ term_to_binary({From,10000,
+ {app,["lapp",{sa,["att",du,{slapp,
+ sitta}]}]}})],
+ ?line gen_tcp:send(SocketB,Message),
+
+ %% At this point the test program starts sending messages (max 10000). Since
+ %% we're not receiving, eventually the send buffer fills up. Then no more
+ %% sending is possible and select() times out. The number of messages sent
+ %% before this happens is returned in Iters. The timeout value for get_term/2
+ %% must be large enough so there's time for the select() to time out and
+ %% the test program to return the error tuple (below).
+ Res0 =
+ if VxSim == false ->
+ ?line {term,{Res,ETO,Iters,ETO}} = runner:get_term(P3, 20000),
+ Res;
+ true -> % relax the test for vxsim
+ ?line case runner:get_term(P3, 20000) of
+ {term,{Res,ETO,Iters,ETO}} ->
+ Res;
+ {term,{Res,_,Iters,ETO}} -> % EIO?
+ Res
+ end
+ end,
+ ?line runner:recv_eot(P3),
+ ?line true = ((Res0 < 0) and (Iters > 0)),
+ ?line gen_tcp:close(SocketB),
+ ?line gen_tcp:close(EpmdSocket),
+ ok.
+
+
+ei_connect_tmo(doc) ->
+ ["Check accept with timeouts."];
+ei_connect_tmo(suite) ->
+ [];
+ei_connect_tmo(Config) when is_list(Config) ->
+ %dbg:tracer(),
+ %dbg:p(self()),
+ VxSim = ?config(vxsim, Config),
+ DummyNode = make_and_check_dummy(),
+ ?line P = runner:start(?connect_tmo),
+ ?line runner:send_term(P,{c_nod_connect_tmo_1,
+ kaksmula_som_ingen_bryr_sig_om,
+ DummyNode}),
+ ETimedout =
+ if VxSim == false ->
+ ?line {term,{-3,ETO,ETO}} = runner:get_term(P, 10000),
+ ?line ETO;
+ true -> % relax the test for vxsim
+ ?line case runner:get_term(P, 10000) of
+ {term,{-3,ETO,ETO}} ->
+ ?line ETO;
+ {term,{-1,_,ETO}} -> % EHOSTUNREACH = ok
+ ?line ETO
+ end
+ end,
+ ?line runner:recv_eot(P),
+ ?line P2 = runner:start(?connect_tmo),
+ ?line runner:send_term(P2,{c_nod_connect_tmo_2,
+ erlang:get_cookie(),
+ node()}),
+ ?line {term, X} = runner:get_term(P2, 10000),
+ ?line runner:recv_eot(P2),
+ ?line true = is_integer(X),
+ %% Aborted handshake test...
+ ?line {_,Host} = split(node()),
+ ?line OurName = join(cccc,Host),
+ ?line Node = join(c_nod_connect_tmo_3,Host),
+ ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of
+ {ok, Socket} ->
+ ?line Socket;
+ Else ->
+ ?line exit(Else)
+ end,
+ ?line EpmdSocket = register(OurName, LSocket, 1, 5),
+ ?line P3 = runner:start(?connect_tmo),
+ ?line Cookie = kaksmula_som_ingen_bryr_sig_om,
+ ?line runner:send_term(P3,{c_nod_connect_tmo_3,
+ Cookie,
+ OurName}),
+ ?line SocketB = case gen_tcp:accept(LSocket) of
+ {ok, Socket1} ->
+ ?line Socket1;
+ Else2 ->
+ ?line exit(Else2)
+ end,
+ ?line {hidden,Node,5} = recv_name(SocketB), % See 1)
+ ?line send_status(SocketB, ok),
+ ?line MyChallengeB = gen_challenge(),
+ ?line send_challenge(SocketB, OurName, MyChallengeB, 5),
+ ?line HisChallengeB = recv_challenge_reply(
+ SocketB,
+ MyChallengeB,
+ Cookie),
+ ?line {term,{-1,ETimedout,ETimedout}} = runner:get_term(P3, 10000),
+ ?line runner:recv_eot(P3),
+ ?line gen_tcp:close(SocketB),
+ ?line gen_tcp:close(EpmdSocket),
+ ok.
+
+
+ei_accept_tmo(doc) ->
+ ["Check accept with timeouts."];
+ei_accept_tmo(suite) ->
+ [];
+ei_accept_tmo(Config) when is_list(Config) ->
+ %%dbg:tracer(),
+ %%dbg:p(self()),
+ ?line P = runner:start(?accept_tmo),
+ ?line runner:send_term(P,{c_nod_som_ingen_kontaktar_1,
+ kaksmula_som_ingen_bryr_sig_om}),
+ ?line {term,{-1,ETimedout,ETimedout}} = runner:get_term(P, 10000),
+ ?line runner:recv_eot(P),
+ ?line P2 = runner:start(?accept_tmo),
+ ?line runner:send_term(P2,{c_nod_som_vi_kontaktar_1,
+ erlang:get_cookie()}),
+ ?line receive after 1000 -> ok end,
+ ?line CNode1 = make_node(c_nod_som_vi_kontaktar_1),
+ ?line {ignored,CNode1} ! tjenare,
+ ?line {term, X} = runner:get_term(P2, 10000),
+ ?line runner:recv_eot(P2),
+ ?line true = is_integer(X),
+ ?line P3 = runner:start(?accept_tmo),
+ ?line runner:send_term(P3,{c_nod_som_vi_kontaktar_2,
+ erlang:get_cookie()}),
+ ?line receive after 1000 -> ok end,
+ ?line CNode2 = make_node(c_nod_som_vi_kontaktar_2),
+ ?line {NA,NB} = split(CNode2),
+ ?line {_,Host} = split(node()),
+ ?line OurName = join(ccc,Host),
+ ?line {port,PortNo,_} = erl_epmd:port_please(NA,NB),
+ ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line send_name(SocketA,OurName,5),
+ ?line ok = recv_status(SocketA),
+ ?line {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1)
+ ?line OurChallengeA = gen_challenge(),
+ ?line OurDigestA = gen_digest(HisChallengeA, erlang:get_cookie()),
+ %% Dont do the last two steps of the connection setup...
+ %% send_challenge_reply(SocketA, OurChallengeA, OurDigestA),
+ %% ok = recv_challenge_ack(SocketA, OurChallengeA, erlang:get_cookie()),
+ ?line {term, {-1,ETimedout,ETimedout}} = runner:get_term(P3, 10000),
+ ?line runner:recv_eot(P3),
+ ?line gen_tcp:close(SocketA),
+ ok.
+
+make_node(X) ->
+ list_to_atom(atom_to_list(X) ++ "@" ++
+ hd(tl(string:tokens(atom_to_list(node()),"@")))).
+
+
+make_and_check_dummy() ->
+ % First check that the host has an ip and is *not* reachable
+ ?line case gen_tcp:connect(?dummy_host,23,[{active,false}],5000) of
+ {error,timeout} -> ok;
+ {error,ehostunreach} -> ok
+ end,
+
+ list_to_atom("dummy@"++atom_to_list(?dummy_host)).
+
+%%
+%% Stolen from the erl_distribution_wb_test in kernel
+%% To be able to do partial handshakes...
+%%
+
+-define(to_port(Socket, Data),
+ case inet_tcp:send(Socket, Data) of
+ {error, closed} ->
+ self() ! {tcp_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+-define(DFLAG_PUBLISHED,1).
+-define(DFLAG_ATOM_CACHE,2).
+-define(DFLAG_EXTENDED_REFERENCES,4).
+-define(DFLAG_EXTENDED_PIDS_PORTS,16#100).
+-define(DFLAG_DIST_MONITOR,8).
+
+%% From R9 and forward extended references is compulsory
+-define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS)).
+
+-define(shutdown(X), exit(X)).
+-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(int32(X),
+ [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(i16(X1,X0),
+ (?u16(X1,X0) -
+ (if (X1) > 127 -> 16#10000; true -> 0 end))).
+
+-define(u16(X1,X0),
+ (((X1) bsl 8) bor (X0))).
+
+-define(u32(X3,X2,X1,X0),
+ (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))).
+
+%%
+%% Handshake utilities
+%%
+
+%%
+%% MD5 hashing
+%%
+
+%% This is no proper random number, but that is not really important in
+%% this test
+gen_challenge() ->
+ {_,_,N} = erlang:now(),
+ N.
+
+%% Generate a message digest from Challenge number and Cookie
+gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) ->
+ C0 = erlang:md5_init(),
+ C1 = erlang:md5_update(C0, atom_to_list(Cookie)),
+ C2 = erlang:md5_update(C1, integer_to_list(Challenge)),
+ binary_to_list(erlang:md5_final(C2)).
+
+
+%%
+%% The differrent stages of the MD5 handshake
+%%
+
+send_status(Socket, Stat) ->
+ case gen_tcp:send(Socket, [$s | atom_to_list(Stat)]) of
+ {error, _} ->
+ ?shutdown(could_not_send_status);
+ _ ->
+ true
+ end.
+
+
+recv_status(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok, [$s|StrStat]} ->
+ list_to_atom(StrStat);
+ Bad ->
+ exit(Bad)
+ end.
+
+send_challenge(Socket, Node, Challenge, Version) ->
+ send_challenge(Socket, Node, Challenge, Version, ?COMPULSORY_DFLAGS).
+send_challenge(Socket, Node, Challenge, Version, Flags) ->
+ {ok, {{Ip1,Ip2,Ip3,Ip4}, _}} = inet:sockname(Socket),
+ ?to_port(Socket, [$n,?int16(Version),?int32(Flags),
+ ?int32(Challenge), atom_to_list(Node)]).
+
+recv_challenge(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} ->
+ Flags = ?u32(Fl1,Fl2,Fl3,Fl4),
+ Type = case Flags band ?DFLAG_PUBLISHED of
+ 0 ->
+ hidden;
+ _ ->
+ normal
+ end,
+ Node =list_to_atom(Ns),
+ Version = ?u16(V1,V0),
+ Challenge = ?u32(CA3,CA2,CA1,CA0),
+ {Type,Node,Version,Challenge};
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+send_challenge_reply(Socket, Challenge, Digest) ->
+ ?to_port(Socket, [$r,?int32(Challenge),Digest]).
+
+recv_challenge_reply(Socket, ChallengeA, Cookie) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 ->
+ SumA = gen_digest(ChallengeA, Cookie),
+ ChallengeB = ?u32(CB3,CB2,CB1,CB0),
+ if SumB == SumA ->
+ ChallengeB;
+ true ->
+ ?shutdown(bad_challenge_reply)
+ end;
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+send_challenge_ack(Socket, Digest) ->
+ ?to_port(Socket, [$a,Digest]).
+
+recv_challenge_ack(Socket, ChallengeB, CookieA) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$a | SumB]} when length(SumB) == 16 ->
+ SumA = gen_digest(ChallengeB, CookieA),
+ if SumB == SumA ->
+ ok;
+ true ->
+ ?shutdown(bad_challenge_ack)
+ end;
+ _ ->
+ ?shutdown(bad_challenge_ack)
+ end.
+
+send_name(Socket, MyNode0, Version) ->
+ send_name(Socket, MyNode0, Version, ?COMPULSORY_DFLAGS).
+send_name(Socket, MyNode0, Version, Flags) ->
+ MyNode = atom_to_list(MyNode0),
+ ?to_port(Socket, [$n,?int16(Version),?int32(Flags)] ++
+ MyNode).
+
+%%
+%% recv_name is common for both old and new handshake.
+%%
+recv_name(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,Data} ->
+ get_name(Data);
+ Res ->
+ ?shutdown({no_node,Res})
+ end.
+
+get_name([$m,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) ->
+ {normal, list_to_atom(OtherNode), ?u16(VersionA,VersionB)};
+get_name([$h,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) ->
+ {hidden, list_to_atom(OtherNode), ?u16(VersionA,VersionB)};
+get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) ->
+ Type = case ?u32(Flag1, Flag2, Flag3, Flag4) band ?DFLAG_PUBLISHED of
+ 0 ->
+ hidden;
+ _ ->
+ normal
+ end,
+ {Type, list_to_atom(OtherNode),
+ ?u16(VersionA,VersionB)};
+get_name(Data) ->
+ ?shutdown(Data).
+
+%%
+%% tell_name is for old handshake
+%%
+tell_name(Socket, MyNode0, Version) ->
+ MyNode = atom_to_list(MyNode0),
+ {ok, {{Ip1,Ip2,Ip3,Ip4}, _}} = inet:sockname(Socket),
+ ?to_port(Socket, [$h,?int16(Version),Ip1,Ip2,Ip3,Ip4] ++
+ MyNode).
+
+%%
+%% The communication with EPMD follows
+%%
+do_register_node(NodeName, TcpPort, VLow, VHigh) ->
+ case gen_tcp:connect({127,0,0,1}, get_epmd_port(), []) of
+ {ok, Socket} ->
+ {N0,_} = split(NodeName),
+ Name = atom_to_list(N0),
+ Extra = "",
+ Elen = length(Extra),
+ Len = 1+2+1+1+2+2+2+length(Name)+2+Elen,
+ gen_tcp:send(Socket, [?int16(Len), $x,
+ ?int16(TcpPort),
+ $M,
+ 0,
+ ?int16(VHigh),
+ ?int16(VLow),
+ ?int16(length(Name)),
+ Name,
+ ?int16(Elen),
+ Extra]),
+ case wait_for_reg_reply(Socket, []) of
+ {error, epmd_close} ->
+ exit(epmd_broken);
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end.
+
+wait_for_reg_reply(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+ case SoFar ++ Data0 of
+ [$y, Result, A, B] ->
+ case Result of
+ 0 ->
+ {alive, Socket, ?u16(A, B)};
+ _ ->
+ {error, duplicate_name}
+ end;
+ Data when length(Data) < 4 ->
+ wait_for_reg_reply(Socket, Data);
+ Garbage ->
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ {error, epmd_close}
+ after 10000 ->
+ gen_tcp:close(Socket),
+ {error, no_reg_reply_from_epmd}
+ end.
+
+
+register(NodeName, ListenSocket, VLow, VHigh) ->
+ {ok,{_,TcpPort}} = inet:sockname(ListenSocket),
+ case do_register_node(NodeName, TcpPort, VLow, VHigh) of
+ {alive, Socket, Creation} ->
+ Socket;
+ Other ->
+ exit(Other)
+ end.
+
+
+%%
+%% Utilities
+%%
+
+%% Split a nodename
+split([$@|T],A) ->
+ {lists:reverse(A),T};
+split([H|T],A) ->
+ split(T,[H|A]).
+
+split(Atom) ->
+ {A,B} = split(atom_to_list(Atom),[]),
+ {list_to_atom(A),list_to_atom(B)}.
+
+%% Build a simple distribution message
+build_message(Cookie) ->
+ [$?,term_to_binary({6,self(),Cookie,rex}),term_to_binary(plupp)].
+
+%% Build a distribution message that will make rex answer
+build_rex_message(Cookie,OurName) ->
+ [$?,term_to_binary({6,self(),Cookie,rex}),
+ term_to_binary({'$gen_cast',
+ {cast,
+ rpc,
+ cast,
+ [OurName, hello, world, []],
+ self()} })].
+
+%% Receive a distribution message
+recv_message(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,Data} ->
+ B0 = list_to_binary(Data),
+ {_,B1} = erlang:split_binary(B0,1),
+ Header = erlang:binary_to_term(B1),
+ Siz = size(term_to_binary(Header)),
+ {_,B2} = erlang:split_binary(B1,Siz),
+ Message = case (catch erlang:binary_to_term(B2)) of
+ {'EXIT', _} ->
+ could_not_digest_message;
+ Other ->
+ Other
+ end,
+ {Header, Message};
+ Res ->
+ exit({no_message,Res})
+ end.
+
+%% Build a nodename
+join(Name,Host) ->
+ list_to_atom(atom_to_list(Name) ++ "@" ++ atom_to_list(Host)).
+
+%% start/stop slave.
+start_node(Name, Param) ->
+ ?t:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+
+get_nodenames(N, T) ->
+ get_nodenames(N, T, []).
+
+get_nodenames(0, _, Acc) ->
+ Acc;
+get_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc]).
+
+get_epmd_port() ->
+ case init:get_argument(epmd_port) of
+ {ok, [[PortStr|_]|_]} when is_list(PortStr) ->
+ list_to_integer(PortStr);
+ error ->
+ 4369 % Default epmd port
+ end.
diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..6eb9f2ce71
--- /dev/null
+++ b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ei_tmo_test_decl.c: ei_tmo_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ei_tmo_test -s erlang halt
diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..a49eeccc02
--- /dev/null
+++ b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src
@@ -0,0 +1,41 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \
+ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EI_TMO_OBJS = ei_tmo_test@obj@ ei_tmo_test_decl@obj@
+
+all: ei_tmo_test@exe@
+
+clean:
+ $(RM) $(EI_TMO_OBJS)
+ $(RM) ei_tmo_test@exe@
+
+ei_tmo_test@exe@: $(EI_TMO_OBJS) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EI_TMO_OBJS) $(LIBFLAGS)
+
diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
new file mode 100644
index 0000000000..2cc9af975d
--- /dev/null
+++ b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
@@ -0,0 +1,767 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2003-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include <stdio.h>
+#include <string.h>
+#ifdef VXWORKS
+#include "reclaim.h"
+#endif
+
+#ifdef __WIN32__
+#include <winsock2.h>
+#include <windows.h>
+#else
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#endif
+
+#include "ei_runner.h"
+
+#ifndef __WIN32__
+#define closesocket(X) close(X)
+#endif
+
+#define DEBUG 1
+
+#ifdef DEBUG
+#include <stdarg.h>
+
+FILE *debugfile = NULL;
+#define OPEN_DEBUGFILE(Number) debugf_open(Number)
+#define CLOSE_DEBUGFILE() debugf_close()
+#define DEBUGF(X) debugf X
+
+static void debugf(char *format, ...)
+{
+ va_list ap;
+ va_start(ap,format);
+ if (debugfile) {
+ vfprintf(debugfile,format,ap);
+ fflush(debugfile);
+ } else {
+ fprintf(stderr,"Attempt to write to debugfile when not open...\n");
+ }
+ va_end(ap);
+}
+
+static void debugf_open(int number)
+{
+ char filename[1024];
+ sprintf(filename,"ei_tmo_test%d.debug",number);
+#if !defined(VXWORKS) && !defined(__WIN32__) && !defined(_OSE_)
+ close(2);
+#endif
+ debugfile = fopen(filename,"a");
+ fprintf(debugfile,"===================================================\n");
+}
+
+static void debugf_close(void)
+{
+ if (debugfile)
+ fclose(debugfile);
+}
+
+#else
+#define OPEN_DEBUGFILE(X) /* noop */
+#define CLOSE_DEBUGFILE() /* noop */
+#define DEBUGF(X) /* noop */
+#endif
+
+TESTCASE(framework_check)
+{
+ char *ptr = NULL;
+ int len;
+
+#ifdef DEBUG
+ int version;
+ int i;
+#endif
+
+ OPEN_DEBUGFILE(1);
+
+ DEBUGF(("B�rjar... \n"));
+ ptr = read_packet(&len);
+ if (*ptr != 't') {
+ DEBUGF(("Gick fel \n"));
+ report(1);
+ } else {
+ ei_x_buff x;
+ ei_x_new(&x);
+ ei_x_append_buf(&x, ptr+1,len-1);
+ DEBUGF(("Gick bra? %d\n",x.index));
+#ifdef DEBUG
+ for(i=0;i < x.index; ++i)
+ DEBUGF(("%d ",(int) ((unsigned char *) x.buff)[i]));
+ DEBUGF(("\n"));
+ len = 0;
+ ei_decode_version(x.buff,&len,&version);
+ ei_print_term(debugfile,x.buff,&len);
+ fflush(debugfile);
+#endif
+ send_bin_term(&x);
+ ei_x_free(&x);
+ }
+ if (ptr != NULL)
+ free(ptr);
+ CLOSE_DEBUGFILE();
+ report(1);
+}
+
+int decode_request(char **nodename_p, char **cookie_p, char **peername_p)
+{
+ char *nodename = NULL;
+ char *cookie = NULL;
+ char *peername = NULL;
+ char *ptr = NULL;
+ ei_x_buff x;
+ int len;
+ int version;
+ int type;
+ int size;
+ int expected_size = (peername_p == NULL) ? 2 : 3;
+ int ret = -1;
+
+ ptr = read_packet(&len);
+ ei_x_new(&x);
+ if (*ptr != 't') {
+ goto cleanup;
+ }
+ ei_x_append_buf(&x, ptr+1,len-1);
+ len = 0;
+ ei_decode_version(x.buff,&len,&version);
+#ifdef DEBUG
+ {
+ int tlen = len;
+ ei_print_term(debugfile,x.buff,&tlen);
+ DEBUGF(("\n"));
+ }
+#endif
+ if (ei_get_type(x.buff,&len,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type != ERL_SMALL_TUPLE_EXT || size != expected_size) {
+ DEBUGF(("Failure at line %d, type=%d, size = %d\n",__LINE__,
+ type,size));
+ goto cleanup;
+ }
+ if (ei_decode_tuple_header(x.buff,&len,&size) != 0 || size != expected_size) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (ei_get_type(x.buff,&len,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type != ERL_ATOM_EXT) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ nodename = malloc(size+1);
+ ei_decode_atom(x.buff,&len,nodename);
+ nodename[size] = '\0'; /* needed????? */
+ if (ei_get_type(x.buff,&len,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type != ERL_ATOM_EXT) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ cookie = malloc(size + 1);
+ ei_decode_atom(x.buff,&len,cookie);
+ cookie[size] = '\0'; /* needed????? */
+ if (expected_size > 2) {
+ if (ei_get_type(x.buff,&len,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type != ERL_ATOM_EXT) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ peername = malloc(size + 1);
+ ei_decode_atom(x.buff,&len,peername);
+ peername[size] = '\0'; /* needed????? */
+ DEBUGF(("nodename = %s, cookie = %s, peername = %s\n",
+ nodename, cookie, peername));
+ *peername_p = peername;
+ peername = NULL;
+ } else {
+ DEBUGF(("nodename = %s, cookie = %s\n",
+ nodename, cookie));
+ }
+ *nodename_p = nodename;
+ nodename = NULL;
+ *cookie_p = cookie;
+ cookie = NULL;
+ ret = 0;
+ cleanup:
+ ei_x_free(&x);
+ if (ptr != NULL) {
+ free(ptr);
+ }
+ if (nodename != NULL) {
+ free(nodename);
+ }
+ if (cookie != NULL) {
+ free(cookie);
+ }
+ if (peername != NULL) {
+ free(peername);
+ }
+ return ret;
+}
+
+int get_message(int com_sock, ei_x_buff *buff,
+ char *atom_buff, erlang_pid *pid, int *iterations)
+{
+ ei_x_buff buffer;
+ int ret_val,index;
+ erlang_msg msg;
+ int res = -1;
+ int totlen;
+ int type;
+ int size;
+ int version;
+ long tmp;
+
+ ei_x_new(&buffer);
+
+ for (;;) {
+ /* Reset buffer index before reading */
+ buffer.index = 0;
+ /* Receive message */
+ if ((ret_val = ei_xreceive_msg(com_sock, &msg, &buffer)) ==
+ ERL_TICK) {
+ /* Ticks are automatically answered, just continue */
+ continue;
+ } else if (ret_val != ERL_MSG) {
+ DEBUGF(("Peer has closed, ret_val = %d (%d).\n",
+ ret_val,erl_errno));
+ goto cleanup;
+ }
+ switch (msg.msgtype) {
+ case ERL_SEND:
+ case ERL_REG_SEND:
+ index = 0;
+ ei_decode_version(buffer.buff,&index,&version);
+ DEBUGF(("Peer sent the following message to me: "));
+#ifdef DEBUG
+ {
+ int ndx = index;
+ /*in debug log on Unix*/
+ ei_print_term(debugfile, buffer.buff, &ndx);
+ }
+#endif
+ DEBUGF(("\n"));
+ if (ei_get_type(buffer.buff,&index,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type != ERL_SMALL_TUPLE_EXT || size != 3) {
+ DEBUGF(("Failure at line %d, type=%d, size = %d\n",__LINE__,
+ type,size));
+ goto cleanup;
+ }
+ if (ei_decode_tuple_header(buffer.buff,&index,&size) != 0 ||
+ size != 3) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (ei_get_type(buffer.buff,&index,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (type == ERL_ATOM_EXT) {
+ ei_decode_atom(buffer.buff,&index,atom_buff);
+ atom_buff[size] ='\0';
+ res = 2;
+ } else if (type == ERL_PID_EXT) {
+ ei_decode_pid(buffer.buff,&index,pid);
+ res = 1;
+ } else {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (ei_get_type(buffer.buff,&index,&type,&size) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ switch (type) {
+ case ERL_SMALL_INTEGER_EXT:
+ case ERL_INTEGER_EXT:
+ ei_decode_long(buffer.buff,&index,&tmp);
+ break;
+ default:
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ *iterations = (int)tmp;
+
+ totlen = buffer.index - index;
+ ei_x_append_buf(buff,buffer.buff+index,totlen);
+ goto cleanup;
+ default:
+ DEBUGF(("Unexpected message type from peer. Goodbye.\n"));
+ goto cleanup;
+ }
+ }
+
+ cleanup:
+ ei_x_free(&buffer);
+ return res;
+}
+TESTCASE(recv_tmo)
+{
+ char *nodename = NULL;
+ char *cookie = NULL;
+ char *peername = NULL;
+ int com_sock = -1;
+ ei_cnode nodeinfo;
+
+
+ OPEN_DEBUGFILE(5);
+
+ if (decode_request(&nodename,&cookie,&peername) != 0) {
+ goto cleanup;
+ }
+ if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) {
+ ei_x_buff answer;
+ DEBUGF(("Got error while connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,erl_errno,ETIMEDOUT);
+#ifdef DEBUG
+ {
+ int tlen = 0;
+ int v;
+ ei_decode_version(answer.buff,&tlen,&v);
+ ei_print_term(debugfile,answer.buff,&tlen);
+ DEBUGF(("\n"));
+ }
+#endif
+ send_bin_term(&answer);
+ DEBUGF(("Binary term sent.\n"));
+ ei_x_free(&answer);
+ } else {
+ ei_x_buff answer;
+ int ret_val;
+ ei_x_buff buffer;
+ erlang_msg msg;
+ int index,version;
+
+ DEBUGF(("Success when connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"~i",com_sock);
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ ei_x_new(&buffer);
+
+ for (;;) {
+ /* Reset buffer index before reading */
+ buffer.index = 0;
+ /* Receive message */
+ if ((ret_val = ei_xreceive_msg_tmo(com_sock, &msg, &buffer,5000))
+ == ERL_TICK) {
+ /* Ticks are automatically answered, just continue */
+ continue;
+ } else if (ret_val != ERL_MSG) {
+ ei_x_new(&answer);
+ ei_x_format(&answer,"{~i,~i,~i}",ret_val,erl_errno,ETIMEDOUT);
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ ei_x_free(&buffer);
+ DEBUGF(("Got error receiving, sending {%d,%d} and exiting\n",
+ ret_val,erl_errno));
+ goto cleanup;
+ }
+ switch (msg.msgtype) {
+ case ERL_SEND:
+ case ERL_REG_SEND:
+ index = 0;
+ ei_decode_version(buffer.buff,&index,&version);
+ DEBUGF(("Peer sent the following message to me: "));
+#ifdef DEBUG
+ {
+ int ndx = index;
+ /*in debug log on Unix*/
+ ei_print_term(debugfile, buffer.buff, &ndx);
+ }
+#endif
+ DEBUGF(("\n"));
+ send_bin_term(&buffer);
+ ei_x_free(&buffer);
+ goto cleanup;
+ default:
+ DEBUGF(("Unexpected message type from peer. Goodbye.\n"));
+ goto cleanup;
+
+ }
+ }
+ }
+cleanup:
+ if (com_sock >= 0) {
+ closesocket(com_sock);
+ }
+
+ if (nodename != NULL) {
+ free(nodename);
+ }
+ if (cookie != NULL) {
+ free(cookie);
+ }
+ if (peername != NULL) {
+ free(peername);
+ }
+ CLOSE_DEBUGFILE();
+ report(1);
+}
+
+TESTCASE(send_tmo)
+{
+ char *nodename = NULL;
+ char *cookie = NULL;
+ char *peername = NULL;
+ int com_sock = -1;
+ ei_cnode nodeinfo;
+
+
+ OPEN_DEBUGFILE(4);
+
+ if (decode_request(&nodename,&cookie,&peername) != 0) {
+ goto cleanup;
+ }
+ if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) {
+ ei_x_buff answer;
+ DEBUGF(("Got error while connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,erl_errno,ETIMEDOUT);
+#ifdef DEBUG
+ {
+ int tlen = 0;
+ int v;
+ ei_decode_version(answer.buff,&tlen,&v);
+ ei_print_term(debugfile,answer.buff,&tlen);
+ DEBUGF(("\n"));
+ }
+#endif
+ send_bin_term(&answer);
+ DEBUGF(("Binary term sent.\n"));
+ ei_x_free(&answer);
+ } else {
+ ei_x_buff answer;
+ char atom[256];
+ erlang_pid pid;
+ int res, iterations, i;
+ ei_x_buff send_buffer;
+
+ DEBUGF(("Success when connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"~i",com_sock);
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ ei_x_new_with_version(&send_buffer);
+ if ((res = get_message(com_sock, &send_buffer,
+ atom ,&pid, &iterations)) < 0) {
+ DEBUGF(("Get_message_failure at line %d\n",__LINE__));
+ ei_x_free(&send_buffer);
+ goto cleanup;
+ }
+ DEBUGF(("Get_message success (%d), bindata:\n",res));
+#ifdef DEBUG
+ {
+ int ndx = 0;
+ int v;
+ ei_decode_version(send_buffer.buff,&ndx,&v);
+ ei_print_term(debugfile, send_buffer.buff, &ndx);
+ }
+#endif
+ DEBUGF(("\n"));
+ switch (res) {
+ case 1: /* Send to pid in 'pid' */
+ ei_x_new(&answer);
+ for (i=0;i < iterations; ++i) {
+ res = ei_send_tmo(com_sock, &pid, send_buffer.buff,
+ send_buffer.index, 5000);
+ DEBUGF(("Sent bindata (%d):\n",res));
+#ifdef DEBUG
+ {
+ int ndx = 0;
+ int v;
+ ei_decode_version(send_buffer.buff,&ndx,&v);
+ ei_print_term(debugfile, send_buffer.buff, &ndx);
+ }
+#endif
+ DEBUGF(("\n"));
+ if (res < 0)
+ break;
+ }
+ if (res < 0) {
+ DEBUGF(("ei_send_tmo failure at line %d\n",__LINE__));
+ ei_x_format(&answer,"{~i,~i,~i,~i}",res,erl_errno,i,ETIMEDOUT);
+ } else {
+ ei_x_format(&answer,"~i",res);
+ }
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ ei_x_free(&send_buffer);
+ goto cleanup;
+ case 2: /* Registered name in 'atom' */
+ ei_x_new(&answer);
+ for (i=0;i < iterations; ++i) {
+ res = ei_reg_send_tmo(&nodeinfo, com_sock, atom,
+ send_buffer.buff,
+ send_buffer.index,5000);
+ if (res < 0)
+ break;
+ }
+ if (res < 0) {
+ DEBUGF(("ei_reg_send_tmo failure at line %d\n",__LINE__));
+ ei_x_format(&answer,"{~i,~i,~i,~i}",res,erl_errno,i,ETIMEDOUT);
+ } else {
+ ei_x_format(&answer,"~i",res);
+ }
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ ei_x_free(&send_buffer);
+ goto cleanup;
+ default:
+ DEBUGF(("unexpected request number %d at line %d\n",res,__LINE__));
+ ei_x_free(&send_buffer);
+ goto cleanup;
+ }
+ }
+cleanup:
+ if (com_sock >= 0) {
+ closesocket(com_sock);
+ }
+
+ if (nodename != NULL) {
+ free(nodename);
+ }
+ if (cookie != NULL) {
+ free(cookie);
+ }
+ if (peername != NULL) {
+ free(peername);
+ }
+ CLOSE_DEBUGFILE();
+ report(1);
+}
+
+
+TESTCASE(connect_tmo)
+{
+ char *nodename = NULL;
+ char *cookie = NULL;
+ char *peername = NULL;
+ int com_sock = -1;
+ ei_cnode nodeinfo;
+
+
+
+ OPEN_DEBUGFILE(3);
+
+ if (decode_request(&nodename,&cookie,&peername) != 0) {
+ goto cleanup;
+ }
+ if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) {
+ ei_x_buff answer;
+ DEBUGF(("Got error while connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+
+ /* On some systems errno gets set to EHOSTUNREACH rather than
+ ETIMEDOUT, which is ok. Let's check for that and report timeout
+ if it happens.
+ Max OS X seems to respond EHOSTDOWN, which should be ok.
+ */
+
+
+#if defined(EHOSTUNREACH)
+ if (errno == EHOSTUNREACH)
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,ETIMEDOUT,ETIMEDOUT);
+ else
+#endif
+
+#if defined(EHOSTDOWN)
+ if (errno == EHOSTDOWN)
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,ETIMEDOUT,ETIMEDOUT);
+ else
+#endif
+
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,erl_errno,ETIMEDOUT);
+
+#ifdef DEBUG
+ {
+ int tlen = 0;
+ int v;
+ ei_decode_version(answer.buff,&tlen,&v);
+ ei_print_term(debugfile,answer.buff,&tlen);
+ DEBUGF(("\n"));
+ }
+#endif
+ send_bin_term(&answer);
+ DEBUGF(("Binary term sent.\n"));
+ ei_x_free(&answer);
+ } else {
+ ei_x_buff answer;
+ DEBUGF(("Success when connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"~i",com_sock);
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ }
+
+cleanup:
+ if (com_sock >= 0) {
+ closesocket(com_sock);
+ }
+
+ if (nodename != NULL) {
+ free(nodename);
+ }
+ if (cookie != NULL) {
+ free(cookie);
+ }
+ if (peername != NULL) {
+ free(peername);
+ }
+ CLOSE_DEBUGFILE();
+ report(1);
+}
+
+TESTCASE(accept_tmo)
+{
+ char *nodename = NULL;
+ char *cookie = NULL;
+ int listen_sock = -1;
+ int epmd_sock = -1;
+ int com_sock = -1;
+ struct sockaddr_in sin;
+ int sin_siz = sizeof(sin);
+ ErlConnect peer;
+ ei_cnode nodeinfo;
+
+
+
+ OPEN_DEBUGFILE(2);
+
+ putenv("EI_TRACELEVEL=10");
+
+ if (decode_request(&nodename,&cookie,NULL) != 0) {
+ goto cleanup;
+ }
+ if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ if ((listen_sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ memset(&sin, 0, sizeof(sin));
+ sin.sin_family = AF_INET;
+ sin.sin_addr.s_addr = INADDR_ANY;
+
+ if (bind(listen_sock,(struct sockaddr *) &sin, sizeof(sin)) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (getsockname(listen_sock,
+ (struct sockaddr *) &sin, &sin_siz) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+ if (listen(listen_sock, 5) != 0) {
+ DEBUGF(("Failure at line %d\n",__LINE__));
+ goto cleanup;
+ }
+
+ if ((epmd_sock = ei_publish(&nodeinfo, ntohs(sin.sin_port))) < 0) {
+ DEBUGF(("Failure at line %d[%d,%d]\n",__LINE__,sin.sin_port,erl_errno));
+ goto cleanup;
+ }
+
+ if ((com_sock = ei_accept_tmo(&nodeinfo,
+ listen_sock, &peer, 5000)) == ERL_ERROR) {
+ ei_x_buff answer;
+ DEBUGF(("Got error while accepting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"{~i,~i,~i}",com_sock,erl_errno,ETIMEDOUT);
+#ifdef DEBUG
+ {
+ int tlen = 0;
+ int v;
+ ei_decode_version(answer.buff,&tlen,&v);
+ ei_print_term(debugfile,answer.buff,&tlen);
+ DEBUGF(("\n"));
+ }
+#endif
+ send_bin_term(&answer);
+ DEBUGF(("Binary term sent.\n"));
+ ei_x_free(&answer);
+ } else {
+ ei_x_buff answer;
+ DEBUGF(("Success when connecting.{%d,%d}\n",com_sock,erl_errno));
+ ei_x_new(&answer);
+ ei_x_format(&answer,"~i",com_sock);
+ send_bin_term(&answer);
+ ei_x_free(&answer);
+ }
+
+cleanup:
+
+ if (listen_sock >= 0) {
+ closesocket(listen_sock);
+ }
+ if (epmd_sock >= 0) {
+ closesocket(epmd_sock);
+ }
+ if (com_sock >= 0) {
+ closesocket(com_sock);
+ }
+
+ if (nodename != NULL) {
+ free(nodename);
+ }
+ if (cookie != NULL) {
+ free(cookie);
+ }
+ CLOSE_DEBUGFILE();
+ report(1);
+}
+
diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl
new file mode 100644
index 0000000000..0d6539d98f
--- /dev/null
+++ b/lib/erl_interface/test/erl_connect_SUITE.erl
@@ -0,0 +1,134 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_connect_SUITE).
+
+-include("test_server.hrl").
+-include("erl_connect_SUITE_data/erl_connect_test_cases.hrl").
+
+-export([all/1,init_per_testcase/2,fin_per_testcase/2,
+ erl_send/1,erl_reg_send/1, erl_send_cookie_file/1]).
+
+-import(runner, [get_term/1,send_term/2]).
+
+all(suite) ->
+ [erl_send,erl_reg_send,erl_send_cookie_file].
+
+init_per_testcase(_Case, Config) ->
+ Dog = ?t:timetrap(?t:minutes(0.25)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+erl_send(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = erl_connect(P, node()),
+
+ ?line ok = erl_send(P, Fd, self(), AMsg={a,message}),
+ ?line receive AMsg -> ok end,
+
+ ?line 0 = erl_close_connection(P,Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+erl_send_cookie_file(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Skipped on VxWorks"};
+ _ ->
+ ?line P = runner:start(?interpret),
+ ?line 1 = erl_connect_init(P, 42, '', 0),
+ ?line {ok,Fd} = erl_connect(P, node()),
+
+ ?line ok = erl_send(P, Fd, self(), AMsg={a,message}),
+ ?line receive AMsg -> ok end,
+
+ ?line 0 = erl_close_connection(P,Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+erl_reg_send(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = erl_connect(P, node()),
+
+ ARegName = a_strange_registred_name,
+ ?line register(ARegName, self()),
+ ?line ok = erl_reg_send(P, Fd, ARegName, AMsg={another,[strange],message}),
+ ?line receive AMsg -> ok end,
+
+ ?line 0 = erl_close_connection(P,Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%%% Interface functions for erl_interface functions.
+
+erl_connect_init(P, Num, Cookie, Creation) ->
+ send_command(P, erl_connect_init, [Num,Cookie,Creation]),
+ case get_term(P) of
+ {term,Int} when is_integer(Int) -> Int
+ end.
+
+erl_connect(P, Node) ->
+ send_command(P, erl_connect, [Node]),
+ case get_term(P) of
+ {term,{Fd,_}} when Fd >= 0 -> {ok,Fd};
+ {term,{-1,Errno}} -> {error,Errno}
+ end.
+
+erl_close_connection(P, FD) ->
+ send_command(P, erl_close_connection, [FD]),
+ case get_term(P) of
+ {term,Int} when is_integer(Int) -> Int
+ end.
+
+erl_send(P, Fd, To, Msg) ->
+ send_command(P, erl_send, [Fd,To,Msg]),
+ get_send_result(P).
+
+erl_reg_send(P, Fd, To, Msg) ->
+ send_command(P, erl_reg_send, [Fd,To,Msg]),
+ get_send_result(P).
+
+get_send_result(P) ->
+ case get_term(P) of
+ {term,{1,_}} -> ok;
+ {term,{-1,Errno}} -> {error,Errno};
+ {term,{Res,Errno}}->
+ io:format("Return value: ~p\nerl_errno: ~p", [Res,Errno]),
+ ?t:fail(bad_return_value)
+ end.
+
+send_command(P, Name, Args) ->
+ runner:send_term(P, {Name,list_to_tuple(Args)}).
+
+
+
+
+
diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..09c00e7b8c
--- /dev/null
+++ b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+erl_connect_test_decl.c: erl_connect_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run erl_connect_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..047a734ecb
--- /dev/null
+++ b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src
@@ -0,0 +1,41 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2000-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+OBJS = erl_connect_test@obj@ erl_connect_test_decl@obj@
+
+all: erl_connect_test@exe@
+
+erl_connect_test@exe@: $(OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(OBJS) $(LIBFLAGS)
+
+clean:
+ $(RM) $(OBJS)
+ $(RM) erl_connect_test@exe@
diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c b/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c
new file mode 100644
index 0000000000..02304260b8
--- /dev/null
+++ b/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c
@@ -0,0 +1,202 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2000-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Tests the functions in erl_connect.c.
+ * Author: Bjorn Gustavsson
+ *
+ * See the erl_connect_SUITE.erl file for a "table of contents".
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+#include "runner.h"
+
+static void cmd_erl_connect_init(ETERM* args);
+static void cmd_erl_connect(ETERM* args);
+static void cmd_erl_send(ETERM* args);
+static void cmd_erl_reg_send(ETERM* args);
+static void cmd_erl_close_connection(ETERM *args);
+
+static void send_errno_result(int value);
+
+static struct {
+ char* name;
+ int num_args; /* Number of arguments. */
+ void (*func)(ETERM* args);
+} commands[] = {
+ "erl_connect_init", 3, cmd_erl_connect_init,
+ "erl_connect", 1, cmd_erl_connect,
+ "erl_close_connection", 1, cmd_erl_close_connection,
+ "erl_send", 3, cmd_erl_send,
+ "erl_reg_send", 3, cmd_erl_reg_send,
+};
+
+
+/*
+ * Sends a list contaning all data types to the Erlang side.
+ */
+
+TESTCASE(interpret)
+{
+ ETERM* term;
+
+ erl_init(NULL, 0);
+
+ outer_loop:
+
+ term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+ ETERM* Func;
+ ETERM* Args;
+ int i;
+
+ if (!ERL_IS_TUPLE(term) || ERL_TUPLE_SIZE(term) != 2) {
+ fail("term should be a tuple of size 2");
+ }
+
+ Func = erl_element(1, term);
+ if (!ERL_IS_ATOM(Func)) {
+ fail("function name should be an atom");
+ }
+ Args = erl_element(2, term);
+ if (!ERL_IS_TUPLE(Args)) {
+ fail("function arguments should be a tuple");
+ }
+ erl_free_term(term);
+ for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) {
+ int n = strlen(commands[i].name);
+ if (ERL_ATOM_SIZE(Func) != n) {
+ continue;
+ }
+ if (memcmp(ERL_ATOM_PTR(Func), commands[i].name, n) == 0) {
+ erl_free_term(Func);
+ if (ERL_TUPLE_SIZE(Args) != commands[i].num_args) {
+ fail("wrong number of arguments");
+ }
+ commands[i].func(Args);
+ erl_free_term(Args);
+ goto outer_loop;
+ }
+ }
+ fail("bad command");
+ }
+}
+
+#define VERIFY_TYPE(Test, Term) \
+if (!Test(Term)) { \
+ fail("wrong type for " #Term); \
+} else { \
+}
+
+static void
+cmd_erl_connect_init(ETERM* args)
+{
+ ETERM* number;
+ ETERM* res;
+ ETERM* cookie;
+ char cookie_buffer[256];
+
+ number = ERL_TUPLE_ELEMENT(args, 0);
+ VERIFY_TYPE(ERL_IS_INTEGER, number);
+ cookie = ERL_TUPLE_ELEMENT(args, 1);
+ VERIFY_TYPE(ERL_IS_ATOM, cookie);
+ if (ERL_ATOM_SIZE(cookie) == 0) {
+ res = erl_mk_int(erl_connect_init(ERL_INT_VALUE(number), 0, 0));
+ } else {
+ memcpy(cookie_buffer, ERL_ATOM_PTR(cookie), ERL_ATOM_SIZE(cookie));
+ cookie_buffer[ERL_ATOM_SIZE(cookie)] = '\0';
+ res = erl_mk_int(erl_connect_init(ERL_INT_VALUE(number),
+ cookie_buffer, 0));
+ }
+ send_term(res);
+ erl_free_term(res);
+}
+
+static void
+cmd_erl_connect(ETERM* args)
+{
+ ETERM* node;
+ char node_buffer[256];
+
+ node = ERL_TUPLE_ELEMENT(args, 0);
+ VERIFY_TYPE(ERL_IS_ATOM, node);
+ memcpy(node_buffer, ERL_ATOM_PTR(node), ERL_ATOM_SIZE(node));
+ node_buffer[ERL_ATOM_SIZE(node)] = '\0';
+ send_errno_result(erl_connect(node_buffer));
+}
+
+static void
+cmd_erl_close_connection(ETERM* args)
+{
+ ETERM* number;
+ ETERM* res;
+
+ number = ERL_TUPLE_ELEMENT(args, 0);
+ VERIFY_TYPE(ERL_IS_INTEGER, number);
+ res = erl_mk_int(erl_close_connection(ERL_INT_VALUE(number)));
+ send_term(res);
+ erl_free_term(res);
+}
+
+static void
+cmd_erl_send(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+ ETERM* to = ERL_TUPLE_ELEMENT(args, 1);
+ ETERM* msg = ERL_TUPLE_ELEMENT(args, 2);
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+ send_errno_result(erl_send(ERL_INT_VALUE(fd_term), to, msg));
+}
+
+static void
+cmd_erl_reg_send(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+ ETERM* to = ERL_TUPLE_ELEMENT(args, 1);
+ ETERM* msg = ERL_TUPLE_ELEMENT(args, 2);
+ char reg_name[256];
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+ VERIFY_TYPE(ERL_IS_ATOM, to);
+ memcpy(reg_name, ERL_ATOM_PTR(to), ERL_ATOM_SIZE(to));
+ reg_name[ERL_ATOM_SIZE(to)] = '\0';
+ send_errno_result(erl_reg_send(ERL_INT_VALUE(fd_term), reg_name, msg));
+}
+
+static void
+send_errno_result(int value)
+{
+ ETERM* res_array[2];
+ ETERM* res_tuple;
+
+ res_array[0] = erl_mk_int(value);
+ res_array[1] = erl_mk_int(erl_errno);
+ res_tuple = erl_mk_tuple(res_array, 2);
+ send_term(res_tuple);
+ erl_free_term(res_array[0]);
+ erl_free_term(res_array[1]);
+ erl_free_term(res_tuple);
+}
diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl
new file mode 100644
index 0000000000..634e2f9aa0
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE.erl
@@ -0,0 +1,1136 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_eterm_SUITE).
+
+-include("test_server.hrl").
+-include("erl_eterm_SUITE_data/eterm_test_cases.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% The tests are organised as follows:
+%%%
+%%% 1. Basic tests (encoding, decoding, memory allocation).
+%%% 2. Constructing terms (the erl_mk_xxx() functions and erl_copy_term()).
+%%% 3. Extracting & info functions (erl_hd(), erl_length() etc).
+%%% 4. I/O list functions.
+%%% 5. Miscellanous functions.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-export([all/1, build_terms/1, round_trip_conversion/1,
+ decode_terms/1, decode_float/1,
+ t_erl_mk_int/1, t_erl_mk_list/1,
+ basic_copy/1,
+ t_erl_cons/1,
+ t_erl_mk_atom/1,
+ t_erl_mk_binary/1,
+ t_erl_mk_empty_list/1,
+ t_erl_mk_float/1,
+ t_erl_mk_pid/1,
+ t_erl_mk_xpid/1,
+ t_erl_mk_port/1,
+ t_erl_mk_xport/1,
+ t_erl_mk_ref/1,
+ t_erl_mk_long_ref/1,
+ t_erl_mk_string/1,
+ t_erl_mk_estring/1,
+ t_erl_mk_tuple/1,
+ t_erl_mk_uint/1,
+ t_erl_mk_var/1,
+ t_erl_size/1,
+ t_erl_var_content/1,
+ t_erl_element/1,
+ t_erl_length/1, t_erl_hd/1, t_erl_tl/1,
+ type_checks/1, extractor_macros/1,
+ t_erl_iolist_length/1, t_erl_iolist_to_binary/1,
+ t_erl_iolist_to_string/1,
+ erl_print_term/1, print_string/1,
+ t_erl_free_compound/1,
+ high_chaparal/1,
+ broken_data/1,
+ cnode_1/1]).
+
+-export([start_cnode/1]).
+
+-import(runner, [get_term/1]).
+
+%% This test suite controls the running of the C language functions
+%% in eterm_test.c and print_term.c.
+
+all(suite) -> [build_terms, round_trip_conversion,
+ decode_terms, decode_float,
+ t_erl_mk_int, t_erl_mk_list,
+ basic_copy,
+ t_erl_mk_atom,
+ t_erl_mk_binary,
+ t_erl_mk_empty_list,
+ t_erl_mk_float,
+ t_erl_mk_pid,
+ t_erl_mk_xpid,
+ t_erl_mk_port,
+ t_erl_mk_xport,
+ t_erl_mk_ref,
+ t_erl_mk_long_ref,
+ t_erl_mk_string,
+ t_erl_mk_estring,
+ t_erl_mk_tuple,
+ t_erl_mk_uint,
+ t_erl_mk_var,
+ t_erl_size,
+ t_erl_var_content,
+ t_erl_element,
+ t_erl_cons,
+ t_erl_length, t_erl_hd, t_erl_tl,
+ type_checks, extractor_macros,
+ t_erl_iolist_length, t_erl_iolist_to_binary,
+ t_erl_iolist_to_string,
+ erl_print_term, print_string,
+ t_erl_free_compound,
+ high_chaparal,
+ broken_data,
+ cnode_1].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% 1. B a s i c t e s t s
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test asks the C function to construct all data types in
+%% a list and verifies that the result is as expected.
+
+build_terms(suite) -> [];
+build_terms(Config) when is_list(Config) ->
+ ?line P = runner:start(?build_terms),
+ ?line {term, Term} = get_term(P),
+ ?line io:format("Received: ~p", [Term]),
+ ?line [ARefLN, ARef, APortLN, APort, APidLN, APid,
+ {element1, 42, 767}, "A string",
+ 1, -1, 0, 3.0, ABin, 'I am an atom'] = Term,
+ ?line "A binary" = binary_to_list(ABin),
+ ?line case ARef of
+ R when is_reference(R), node(R) == kalle@localhost -> ok
+ end,
+ ?line case ARefLN of
+ R1 when is_reference(R1), node(R1) == abcdefghijabcdefghij@localhost -> ok
+ end,
+ ?line case APort of
+ Port when is_port(Port), node(Port) == kalle@localhost -> ok
+ end,
+ ?line case APortLN of
+ Port1 when is_port(Port1), node(Port1) == abcdefghijabcdefghij@localhost -> ok
+ end,
+ ?line case APid of
+ Pid when is_pid(Pid), node(Pid) == kalle@localhost -> ok
+ end,
+ ?line case APidLN of
+ Pid1 when is_pid(Pid1), node(Pid1) == abcdefghijabcdefghij@localhost -> ok
+ end,
+
+ ?line runner:recv_eot(P),
+ ok.
+
+%% This test is run entirely in C code.
+
+round_trip_conversion(suite) -> [];
+round_trip_conversion(Config) when is_list(Config) ->
+ ?line runner:test(?round_trip_conversion),
+ ok.
+
+%% This test sends a list of all data types to the C code function,
+%% which decodes it and verifies it.
+
+decode_terms(suite) -> [];
+decode_terms(Config) when is_list(Config) ->
+ ?line Dummy1 = list_to_atom(filename:join(?config(priv_dir, Config),
+ dummy_file1)),
+ ?line Dummy2 = list_to_atom(filename:join(?config(priv_dir, Config),
+ dummy_file2)),
+ ?line Port1 = open_port(Dummy1, [out]),
+ ?line Port2 = open_port(Dummy2, [out]),
+ ?line ABinary = list_to_binary("A binary"),
+ ?line Terms = [make_ref(), make_ref(),
+ Port1, Port2,
+ self(), self(),
+ {element1, 42, 767}, "A string",
+ 1, -1, 0, 3.0, ABinary, 'I am an atom'],
+
+ ?line P = runner:start(?decode_terms),
+ ?line runner:send_term(P, Terms),
+ ?line runner:recv_eot(P),
+
+ ok.
+
+%% Decodes the floating point number 3.1415.
+
+decode_float(suite) -> [];
+decode_float(Config) when is_list(Config) ->
+ ?line P = runner:start(?decode_float),
+ ?line runner:send_term(P, 3.1415),
+ ?line runner:recv_eot(P),
+ ok.
+
+%% Tests the erl_free_compound() function.
+
+t_erl_free_compound(suite) -> [];
+t_erl_free_compound(Config) when is_list(Config) ->
+ ?line runner:test(?t_erl_free_compound),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% 2. C o n s t r u c t i n g t e r m s
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This tests the erl_mk_list() function.
+
+t_erl_mk_list(suite) -> [];
+t_erl_mk_list(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_list),
+
+ ?line {term, []} = get_term(P),
+ ?line {term, [abc]} = get_term(P),
+ ?line {term, [abcdef, 42]} = get_term(P),
+ ?line {term, [0.0, 23, [], 3.1415]} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_int() function.
+
+t_erl_mk_int(suite) -> [];
+t_erl_mk_int(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_int),
+
+ ?line {term, 0} = get_term(P),
+ ?line {term, 127} = get_term(P),
+ ?line {term, 128} = get_term(P),
+ ?line {term, 255} = get_term(P),
+ ?line {term, 256} = get_term(P),
+
+ ?line {term, 16#FFFF} = get_term(P),
+ ?line {term, 16#10000} = get_term(P),
+
+ ?line {term, 16#07FFFFFF} = get_term(P),
+ ?line {term, 16#0FFFFFFF} = get_term(P),
+ ?line {term, 16#1FFFFFFF} = get_term(P),
+ ?line {term, 16#3FFFFFFF} = get_term(P),
+ ?line {term, 16#7FFFFFFF} = get_term(P),
+
+ ?line {term, 16#08000000} = get_term(P),
+ ?line {term, 16#10000000} = get_term(P),
+ ?line {term, 16#20000000} = get_term(P),
+ ?line {term, 16#40000000} = get_term(P),
+
+
+ ?line {term, -16#07FFFFFF} = get_term(P),
+ ?line {term, -16#0FFFFFFF} = get_term(P),
+ ?line {term, -16#1FFFFFFF} = get_term(P),
+ ?line {term, -16#3FFFFFFF} = get_term(P),
+ ?line {term, -16#7FFFFFFF} = get_term(P),
+
+ ?line {term, -16#08000000} = get_term(P),
+ ?line {term, -16#10000000} = get_term(P),
+ ?line {term, -16#20000000} = get_term(P),
+ ?line {term, -16#40000000} = get_term(P),
+
+ ?line {term, -16#08000001} = get_term(P),
+ ?line {term, -16#10000001} = get_term(P),
+ ?line {term, -16#20000001} = get_term(P),
+ ?line {term, -16#40000001} = get_term(P),
+
+ ?line {term, -16#08000002} = get_term(P),
+ ?line {term, -16#10000002} = get_term(P),
+ ?line {term, -16#20000002} = get_term(P),
+ ?line {term, -16#40000002} = get_term(P),
+
+ ?line {term, -1999999999} = get_term(P),
+ ?line {term, -2000000000} = get_term(P),
+ ?line {term, -2000000001} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% Basic test of erl_copy_term().
+
+basic_copy(suite) -> [];
+basic_copy(Config) when is_list(Config) ->
+ ?line runner:test(?basic_copy),
+ ok.
+
+
+%% This tests the erl_mk_tuple() function.
+
+t_erl_mk_tuple(suite) -> [];
+t_erl_mk_tuple(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_tuple),
+
+ ?line {term, {madonna, 21, 'mad donna', 12}} = get_term(P),
+ ?line {term, {'Madonna',21,{children,{"Isabella",2}},
+ {'home page',"http://www.madonna.com/"}}} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_atom() function.
+
+t_erl_mk_atom(suite) -> [];
+t_erl_mk_atom(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_atom),
+
+ ?line {term, madonna} = (get_term(P)),
+ ?line {term, 'Madonna'} = (get_term(P)),
+ ?line {term, 'mad donna'} = (get_term(P)),
+ ?line {term, '_madonna_'} = (get_term(P)),
+ ?line {term, '/home/madonna/tour_plan'} = (get_term(P)),
+ ?line {term, 'http://www.madonna.com/tour_plan'} = (get_term(P)),
+ ?line {term, '\'madonna\''} = (get_term(P)),
+ ?line {term, '\"madonna\"'} = (get_term(P)),
+ ?line {term, '\\madonna\\'} = (get_term(P)),
+ ?line {term, '{madonna,21,\'mad donna\',12}'} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_binary() function.
+
+t_erl_mk_binary(suite) -> [];
+t_erl_mk_binary(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_binary),
+
+ ?line {term, Bin} = (get_term(P)),
+ ?line "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}" =
+ binary_to_list(Bin),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_empty_list() function.
+
+t_erl_mk_empty_list(suite) -> [];
+t_erl_mk_empty_list(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_empty_list),
+
+ ?line {term, []} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_float() function.
+
+t_erl_mk_float(suite) -> [];
+t_erl_mk_float(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skipped, "Floating point numbers never compare equal on PPC"};
+ _ ->
+ ?line P = runner:start(?t_erl_mk_float),
+ ?line {term, {3.1415, 1.999999, 2.000000, 2.000001,
+ 2.000002, 12345.67890}} =
+ get_term(P),
+ ?line runner:recv_eot(P),
+ ok
+ end.
+
+
+%% This tests the erl_mk_pid() function.
+
+t_erl_mk_pid(suite) -> [];
+t_erl_mk_pid(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_pid),
+
+ ?line {term, A_pid} = (get_term(P)),
+ ?line {pid, kalle@localhost, 3, 2} = nc2vinfo(A_pid),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+t_erl_mk_xpid(suite) -> [];
+t_erl_mk_xpid(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_xpid),
+
+ ?line {term, A_pid} = (get_term(P)),
+ ?line {pid, kalle@localhost, 32767, 8191} = nc2vinfo(A_pid),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_port() function.
+
+t_erl_mk_port(suite) -> [];
+t_erl_mk_port(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_port),
+
+ ?line {term, A_port} = (get_term(P)),
+ ?line {port, kalle@localhost, 4} = nc2vinfo(A_port),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+t_erl_mk_xport(suite) -> [];
+t_erl_mk_xport(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_xport),
+
+ ?line {term, A_port} = (get_term(P)),
+ ?line {port, kalle@localhost, 268435455} = nc2vinfo(A_port),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_ref() function.
+
+t_erl_mk_ref(suite) -> [];
+t_erl_mk_ref(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_ref),
+
+ ?line {term, A_ref} = (get_term(P)),
+ ?line {ref, kalle@localhost, _Length, [6]} = nc2vinfo(A_ref),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+t_erl_mk_long_ref(suite) -> [];
+t_erl_mk_long_ref(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_long_ref),
+
+ ?line {term, A_ref} = (get_term(P)),
+ ?line {ref, kalle@localhost, _Length, [4294967295,4294967295,262143]}
+ = nc2vinfo(A_ref),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_string() function.
+
+t_erl_mk_string(suite) -> [];
+t_erl_mk_string(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_string),
+
+ ?line {term, "madonna"} = (get_term(P)),
+ ?line {term, "Madonna"} = (get_term(P)),
+ ?line {term, "mad donna"} = (get_term(P)),
+ ?line {term, "_madonna_"} = (get_term(P)),
+ ?line {term, "/home/madonna/tour_plan"} = (get_term(P)),
+ ?line {term, "http://www.madonna.com/tour_plan"} = (get_term(P)),
+ ?line {term, "\'madonna\'"} = (get_term(P)),
+ ?line {term, "\"madonna\""} = (get_term(P)),
+ ?line {term, "\\madonna\\"} = (get_term(P)),
+ ?line {term, "{madonna,21,'mad donna',12}"} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_estring() function.
+
+t_erl_mk_estring(suite) -> [];
+t_erl_mk_estring(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_estring),
+
+ ?line {term, "madonna"} = (get_term(P)),
+ ?line {term, "Madonna"} = (get_term(P)),
+ ?line {term, "mad donna"} = (get_term(P)),
+ ?line {term, "_madonna_"} = (get_term(P)),
+ ?line {term, "/home/madonna/tour_plan"} = (get_term(P)),
+ ?line {term, "http://www.madonna.com/tour_plan"} = (get_term(P)),
+ ?line {term, "\'madonna\'"} = (get_term(P)),
+ ?line {term, "\"madonna\""} = (get_term(P)),
+ ?line {term, "\\madonna\\"} = (get_term(P)),
+ ?line {term, "{madonna,21,'mad donna',12}"} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_uint() function.
+
+t_erl_mk_uint(suite) -> [];
+t_erl_mk_uint(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_uint),
+
+ ?line {term, 54321} = (get_term(P)),
+ ?line {term, 2147483647} = (get_term(P)),
+ ?line {term, 2147483648} = (get_term(P)),
+ ?line {term, 2147483649} = (get_term(P)),
+ ?line {term, 2147483650} = (get_term(P)),
+ ?line {term, 4294967295} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_mk_var() function.
+
+t_erl_mk_var(suite) -> [];
+t_erl_mk_var(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_mk_var),
+
+ ?line {term, 1} = (get_term(P)),
+ ?line {term, 0} = (get_term(P)),
+ ?line {term, 1} = (get_term(P)),
+ ?line {term, 0} = (get_term(P)),
+ ?line {term, 1} = (get_term(P)),
+ ?line {term, 0} = (get_term(P)),
+ ?line {term, 1} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_cons() function.
+
+t_erl_cons(suite) -> [];
+t_erl_cons(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_cons),
+
+ ?line {term, [madonna, 21]} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% 3. E x t r a c t i n g & i n f o f u n c t i o n s
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Tests the erl_length() function.
+
+t_erl_length(suite) -> [];
+t_erl_length(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_length),
+
+ ?line 0 = erl_length(P, []),
+ ?line 1 = erl_length(P, [a]),
+ ?line 2 = erl_length(P, [a, b]),
+ ?line 3 = erl_length(P, [a, b, c]),
+
+ ?line 4 = erl_length(P, [a, [x, y], c, []]),
+
+ ?line -1 = erl_length(P, [a|b]),
+ ?line -1 = erl_length(P, a),
+
+ ?line runner:finish(P),
+ ok.
+
+%% Invokes the erl_length() function.
+
+erl_length(Port, List) ->
+ call_erl_function(Port, List).
+
+%% Tests the erl_hd() function.
+
+t_erl_hd(suite) -> [];
+t_erl_hd(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_hd),
+
+ ?line 'NULL' = erl_hd(P, 42),
+ ?line 'NULL' = erl_hd(P, abc),
+ ?line 'NULL' = erl_hd(P, []),
+
+ ?line [] = erl_hd(P, [[], a]),
+ ?line a = erl_hd(P, [a]),
+ ?line a = erl_hd(P, [a, b]),
+ ?line a = erl_hd(P, [a, b, c]),
+ ?line a = erl_hd(P, [a|b]),
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+%% Invokes the erl_hd() function.
+
+erl_hd(Port, List) ->
+ call_erl_function(Port, List).
+
+%% Tests the erl_tail() function.
+
+t_erl_tl(suite) -> [];
+t_erl_tl(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_tl),
+
+ ?line 'NULL' = erl_tl(P, 42),
+ ?line 'NULL' = erl_tl(P, abc),
+ ?line 'NULL' = erl_tl(P, []),
+
+ ?line [] = erl_tl(P, [a]),
+ ?line [b] = erl_tl(P, [a, b]),
+ ?line [b, c] = erl_tl(P, [a, b, c]),
+
+ ?line b = erl_tl(P, [a|b]),
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+%% Invokes the erl_tail() function in erl_interface.
+
+erl_tl(Port, List) ->
+ call_erl_function(Port, List).
+
+%% Tests the type checking macros (done in the C program).
+
+type_checks(suite) -> [];
+type_checks(Config) when is_list(Config) ->
+ ?line runner:test(?type_checks),
+ ok.
+
+%% Tests the extractor macros (done in the C program).
+
+extractor_macros(suite) -> [];
+extractor_macros(Config) when is_list(Config) ->
+ ?line runner:test(?extractor_macros),
+ ok.
+
+
+%% This tests the erl_size() function.
+
+t_erl_size(suite) -> [];
+t_erl_size(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_size),
+
+ ?line {term, 0} = (get_term(P)),
+ ?line {term, 4} = (get_term(P)),
+
+ ?line {term, 0} = (get_term(P)),
+ ?line {term, 27} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_var_content() function.
+
+t_erl_var_content(suite) -> [];
+t_erl_var_content(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_var_content),
+
+ ?line {term, 17} = (get_term(P)),
+ ?line {term, "http://www.madonna.com"} = (get_term(P)),
+ ?line {term, 2} = (get_term(P)),
+ ?line {term, "http://www.madonna.com"} = (get_term(P)),
+ ?line {term, 2} = (get_term(P)),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+%% This tests the erl_element() function.
+
+t_erl_element(suite) -> [];
+t_erl_element(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_element),
+
+ ?line {term, madonna} = get_term(P),
+ ?line {term, 21} = get_term(P),
+ ?line {term, 'mad donna'} = get_term(P),
+ ?line {term, 12} = get_term(P),
+
+ ?line {term, 'Madonna'} = get_term(P),
+ ?line {term, 21} = get_term(P),
+ ?line {term, {children,{"Isabella",2}}} = get_term(P),
+ ?line {term, {'home page',"http://www.madonna.com/"}} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% 4. I / O l i s t f u n c t i o n s
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Tests the erl_iolist_length() function.
+
+t_erl_iolist_length(suite) -> [];
+t_erl_iolist_length(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_iolist_length),
+
+ %% Flat lists.
+
+ ?line 0 = erl_iolist_length(P, []),
+ ?line 1 = erl_iolist_length(P, [10]),
+ ?line 2 = erl_iolist_length(P, [10, 20]),
+ ?line 3 = erl_iolist_length(P, [10, 20, 30]),
+ ?line 256 = erl_iolist_length(P, lists:seq(0, 255)),
+
+ %% Deep lists.
+
+ ?line 0 = erl_iolist_length(P, [[]]),
+ ?line 1 = erl_iolist_length(P, [[], 42]),
+ ?line 1 = erl_iolist_length(P, [42, []]),
+ ?line 2 = erl_iolist_length(P, [42, [], 45]),
+
+ ?line 3 = erl_iolist_length(P, [42, [90], 45]),
+ ?line 3 = erl_iolist_length(P, [[42, [90]], 45]),
+ ?line 3 = erl_iolist_length(P, [[42, [90]], 45]),
+
+ %% List with binaries.
+
+ ?line 0 = erl_iolist_length(P, [list_to_binary([])]),
+ ?line 0 = erl_iolist_length(P, [[], list_to_binary([])]),
+ ?line 1 = erl_iolist_length(P, [[1], list_to_binary([])]),
+ ?line 1 = erl_iolist_length(P, [[], list_to_binary([2])]),
+ ?line 2 = erl_iolist_length(P, [[42], list_to_binary([2])]),
+ ?line 4 = erl_iolist_length(P, [[42], list_to_binary([2, 3, 4])]),
+
+ %% Binaries as tail.
+
+ ?line 0 = erl_iolist_length(P, [[]| list_to_binary([])]),
+ ?line 1 = erl_iolist_length(P, [[1]| list_to_binary([])]),
+ ?line 1 = erl_iolist_length(P, [[]| list_to_binary([2])]),
+ ?line 2 = erl_iolist_length(P, [[42]| list_to_binary([2])]),
+
+ %% Binaries only.
+
+ ?line 0 = erl_iolist_length(P, list_to_binary("")),
+ ?line 1 = erl_iolist_length(P, list_to_binary([1])),
+ ?line 2 = erl_iolist_length(P, list_to_binary([1, 2])),
+
+ %% Illegal cases.
+
+ ?line -1 = erl_iolist_length(P, [42|43]),
+ ?line -1 = erl_iolist_length(P, a),
+
+ ?line -1 = erl_iolist_length(P, [a]),
+ ?line -1 = erl_iolist_length(P, [256]),
+ ?line -1 = erl_iolist_length(P, [257]),
+ ?line -1 = erl_iolist_length(P, [-1]),
+ ?line -1 = erl_iolist_length(P, [-2]),
+ ?line -1 = erl_iolist_length(P, [-127]),
+ ?line -1 = erl_iolist_length(P, [-128]),
+
+ ?line runner:finish(P),
+ ok.
+
+%% Invokes the erl_iolist_length() function.
+
+erl_iolist_length(Port, List) ->
+ call_erl_function(Port, List).
+
+%% Tests the erl_iolist_to_binary() function.
+
+t_erl_iolist_to_binary(suite) -> [];
+t_erl_iolist_to_binary(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_iolist_to_binary),
+
+ %% Flat lists.
+
+ ?line [] = iolist_to_list(P, []),
+ ?line [10] = iolist_to_list(P, [10]),
+ ?line [10, 20] = iolist_to_list(P, [10, 20]),
+ ?line [10, 20, 30] = iolist_to_list(P, [10, 20, 30]),
+ ?line AllBytes = lists:seq(0, 255),
+ ?line AllBytes = iolist_to_list(P, AllBytes),
+
+ %% Deep lists.
+
+ ?line [] = iolist_to_list(P, [[]]),
+ ?line [42] = iolist_to_list(P, [[], 42]),
+ ?line [42] = iolist_to_list(P, [42, []]),
+ ?line [42, 45] = iolist_to_list(P, [42, [], 45]),
+
+ ?line [42, 90, 45] = iolist_to_list(P, [42, [90], 45]),
+ ?line [42, 90, 45] = iolist_to_list(P, [[42, [90]], 45]),
+ ?line [42, 90, 45] = iolist_to_list(P, [[42, [90]], 45]),
+
+ %% List with binaries.
+
+ ?line [] = iolist_to_list(P, [list_to_binary([])]),
+ ?line [] = iolist_to_list(P, [[], list_to_binary([])]),
+ ?line [1] = iolist_to_list(P, [[1], list_to_binary([])]),
+ ?line [2] = iolist_to_list(P, [[], list_to_binary([2])]),
+ ?line [42, 2] = iolist_to_list(P, [[42], list_to_binary([2])]),
+ ?line [42, 2, 3, 4] = iolist_to_list(P, [[42], list_to_binary([2, 3, 4])]),
+
+ %% Binaries as tail.
+
+ ?line [] = iolist_to_list(P, [[]| list_to_binary([])]),
+ ?line [1] = iolist_to_list(P, [[1]| list_to_binary([])]),
+ ?line [2] = iolist_to_list(P, [[]| list_to_binary([2])]),
+ ?line [42, 2] = iolist_to_list(P, [[42]| list_to_binary([2])]),
+
+ %% Binaries only.
+
+ ?line [] = iolist_to_list(P, list_to_binary("")),
+ ?line [1] = iolist_to_list(P, list_to_binary([1])),
+ ?line [1, 2] = iolist_to_list(P, list_to_binary([1, 2])),
+
+ %% Illegal cases.
+
+ ?line 'NULL' = iolist_to_list(P, [42|43]),
+ ?line 'NULL' = iolist_to_list(P, a),
+
+ ?line 'NULL' = iolist_to_list(P, [a]),
+ ?line 'NULL' = iolist_to_list(P, [256]),
+ ?line 'NULL' = iolist_to_list(P, [257]),
+ ?line 'NULL' = iolist_to_list(P, [-1]),
+ ?line 'NULL' = iolist_to_list(P, [-2]),
+ ?line 'NULL' = iolist_to_list(P, [-127]),
+ ?line 'NULL' = iolist_to_list(P, [-128]),
+
+ ?line runner:finish(P),
+ ok.
+
+iolist_to_list(Port, Term) ->
+ case call_erl_function(Port, Term) of
+ 'NULL' ->
+ 'NULL';
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin)
+ end.
+
+%% Tests the erl_iolist_to_string() function.
+
+t_erl_iolist_to_string(suite) -> [];
+t_erl_iolist_to_string(Config) when is_list(Config) ->
+ ?line P = runner:start(?t_erl_iolist_to_string),
+
+ %% Flat lists.
+
+ ?line [0] = iolist_to_string(P, []),
+ ?line [10, 0] = iolist_to_string(P, [10]),
+ ?line [10, 20, 0] = iolist_to_string(P, [10, 20]),
+ ?line [10, 20, 30, 0] = iolist_to_string(P, [10, 20, 30]),
+ ?line AllBytes = lists:seq(1, 255)++[0],
+ ?line AllBytes = iolist_to_string(P, lists:seq(1, 255)),
+
+ %% Deep lists.
+
+ ?line [0] = iolist_to_string(P, [[]]),
+ ?line [42, 0] = iolist_to_string(P, [[], 42]),
+ ?line [42, 0] = iolist_to_string(P, [42, []]),
+ ?line [42, 45, 0] = iolist_to_string(P, [42, [], 45]),
+
+ ?line [42, 90, 45, 0] = iolist_to_string(P, [42, [90], 45]),
+ ?line [42, 90, 45, 0] = iolist_to_string(P, [[42, [90]], 45]),
+ ?line [42, 90, 45, 0] = iolist_to_string(P, [[42, [90]], 45]),
+
+ %% List with binaries.
+
+ ?line [0] = iolist_to_string(P, [list_to_binary([])]),
+ ?line [0] = iolist_to_string(P, [[], list_to_binary([])]),
+ ?line [1, 0] = iolist_to_string(P, [[1], list_to_binary([])]),
+ ?line [2, 0] = iolist_to_string(P, [[], list_to_binary([2])]),
+ ?line [42, 2, 0] = iolist_to_string(P, [[42], list_to_binary([2])]),
+ ?line [42, 2, 3, 4, 0] = iolist_to_string(P, [[42],
+ list_to_binary([2, 3, 4])]),
+
+ %% Binaries as tail.
+
+ ?line [0] = iolist_to_string(P, [[]| list_to_binary([])]),
+ ?line [1, 0] = iolist_to_string(P, [[1]| list_to_binary([])]),
+ ?line [2, 0] = iolist_to_string(P, [[]| list_to_binary([2])]),
+ ?line [42, 2, 0] = iolist_to_string(P, [[42]| list_to_binary([2])]),
+
+ %% Binaries only.
+
+ ?line [0] = iolist_to_string(P, list_to_binary("")),
+ ?line [1, 0] = iolist_to_string(P, list_to_binary([1])),
+ ?line [1, 2, 0] = iolist_to_string(P, list_to_binary([1, 2])),
+
+ %% Illegal cases.
+
+ ?line 'NULL' = iolist_to_string(P, [0]),
+ ?line 'NULL' = iolist_to_string(P, [65, 0, 66]),
+ ?line 'NULL' = iolist_to_string(P, [65, 66, 67, 0]),
+
+ ?line 'NULL' = iolist_to_string(P, [42|43]),
+ ?line 'NULL' = iolist_to_string(P, a),
+
+ ?line 'NULL' = iolist_to_string(P, [a]),
+ ?line 'NULL' = iolist_to_string(P, [256]),
+ ?line 'NULL' = iolist_to_string(P, [257]),
+ ?line 'NULL' = iolist_to_string(P, [-1]),
+ ?line 'NULL' = iolist_to_string(P, [-2]),
+ ?line 'NULL' = iolist_to_string(P, [-127]),
+ ?line 'NULL' = iolist_to_string(P, [-128]),
+
+ ?line runner:finish(P),
+ ok.
+
+%% Invokes the erl_iolist_to_string() function.
+
+iolist_to_string(Port, Term) ->
+ runner:send_term(Port, Term),
+ case get_term(Port) of
+ {bytes, Result} -> Result;
+ 'NULL' -> 'NULL'
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% 5. M i s c e l l a n o u s T e s t s
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+erl_print_term(suite) -> [];
+erl_print_term(doc) -> "Tests the erl_print_term() function";
+erl_print_term(Config) when is_list(Config) ->
+ ?line PrintTerm = print_term(Config),
+ ?line P = open_port({spawn, PrintTerm}, [stream]),
+
+ %% Lists.
+
+ ?line print(P, "[]", []),
+ ?line print(P, "[a]", [a]),
+ ?line print(P, "[[a]]", [[a]]),
+ ?line print(P, "[[]]", [[]]),
+ ?line print(P, "[a,b,c]", [a,b,c]),
+ ?line print(P, "[a,b|c]", [a,b|c]),
+ ?line print(P, "[a,[],c]", [a,[],c]),
+ ?line print(P, "[a,[1000,1],c]", [a,[1000,1],c]),
+
+ %% Tuples.
+
+ ?line print(P, "{}", {}),
+ ?line print(P, "{ok}", {ok}),
+ ?line print(P, "{1,2,3}", {1, 2, 3}),
+
+ %% Pids.
+
+ ?line {_X, Y, Z} = split_pid(self()),
+ ?line PidString = lists:flatten(io_lib:format("<~s.~w.~w>",
+ [node(), Y, Z])),
+ ?line print(P, PidString, self()),
+
+ ?line unlink(P),
+ ?line exit(P, die),
+ ok.
+
+split_pid(Pid) when is_pid(Pid) ->
+ split_pid(pid_to_list(Pid), 0, []).
+
+split_pid([$<|Rest], Cur, Result) ->
+ split_pid(Rest, Cur, Result);
+split_pid([Digit|Rest], Cur, Result) when $0 =< Digit, Digit =< $9 ->
+ split_pid(Rest, 10*Cur+Digit-$0, Result);
+split_pid([$.|Rest], Cur, Result) ->
+ split_pid(Rest, 0, Result++[Cur]);
+split_pid([$>], Cur, Result) ->
+ list_to_tuple(Result++[Cur]).
+
+print_string(suite) -> [];
+print_string(doc) -> "Test printing a string with erl_print_term()";
+print_string(Config) when is_list(Config) ->
+ ?line PrintTerm = print_term(Config),
+ ?line P = open_port({spawn, PrintTerm}, [stream]),
+
+ %% Strings.
+
+ ?line print(P, "\"ABC\"", "ABC"),
+ ?line {11, "\"\\tABC\\r\\n\""} = print(P, "\tABC\r\n"),
+
+ %% Not strings.
+
+ ?line print(P, "[65,66,67,0]", "ABC\000"),
+
+ ?line unlink(P),
+ ?line exit(P, die),
+ ok.
+
+print(Port, TermString, Term) ->
+ Length = length(TermString),
+ {Length, TermString} = print(Port, Term).
+
+%% This function uses the erl_print_term() function in erl_interface
+%% to print a term.
+%% Returns: {NumChars, Chars}
+
+print(Port, Term) ->
+ Bin = term_to_binary(Term),
+ Size = size(Bin),
+ Port ! {self(), {command, [Size div 256, Size rem 256, Bin]}},
+ collect_line(Port, []).
+
+collect_line(Port, Result) ->
+ receive
+ {Port, {data, Data}} ->
+ case lists:reverse(Data) of
+ [$\n|Rest] ->
+ collect_line1(Rest++Result, []);
+ Chars ->
+ collect_line(Port, Chars++Result)
+ end
+ after test_server:seconds(5) ->
+ test_server:fail("No response from C program")
+ end.
+
+collect_line1([$\r|Rest], Result) ->
+ {list_to_integer(Result), lists:reverse(Rest)};
+collect_line1([C|Rest], Result) ->
+ collect_line1(Rest, [C|Result]).
+
+%% Test case submitted by Per Lundgren, ERV.
+
+high_chaparal(suite) -> [];
+high_chaparal(Config) when is_list(Config) ->
+ ?line P = runner:start(?high_chaparal),
+ ?line {term, [hello, world]} = get_term(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+%% OTP-7448
+broken_data(suite) -> [];
+broken_data(Config) when is_list(Config) ->
+ ?line P = runner:start(?broken_data),
+ ?line runner:recv_eot(P),
+ ok.
+
+%% This calls a C function with one parameter and returns the result.
+
+call_erl_function(Port, Term) ->
+ runner:send_term(Port, Term),
+ case get_term(Port) of
+ {term, Result} -> Result;
+ 'NULL' -> 'NULL'
+ end.
+
+print_term(Config) when is_list(Config) ->
+ filename:join(?config(data_dir, Config), "print_term").
+
+
+
+%%% We receive a ref from the cnode, and expect it to be a long ref.
+%%% We also send a ref we created ourselves, and expect to get it
+%%% back, without having been mutated into short form. We must take
+%%% care then to check the actual returned ref, and not the original
+%%% one, which is equal to it.
+cnode_1(suite) -> [];
+cnode_1(doc) -> "Tests involving cnode: sends a long ref from a cnode to us";
+cnode_1(Config) when is_list(Config) ->
+ ?line Cnode = filename:join(?config(data_dir, Config), "cnode"),
+ ?line register(mip, self()),
+ ?line spawn_link(?MODULE, start_cnode, [Cnode]),
+ ?line Ref1 = get_ref(),
+ io:format("Ref1 ~p~n", [Ref1]),
+ ?line check_ref(Ref1),
+ ?line Ref2 = make_ref(),
+ ?line receive
+ Pid -> Pid
+ end,
+ ?line Fun1 = fun(X) -> {Pid, X} end, % sneak in a fun test here
+ %?line Fun1 = {wait_with_funs, new_dist_format},
+ ?line Term = {Ref2, Fun1, {1,2,3,4,5,6,7,8,9,10}},
+ %% A term which will overflow the original buffer used in 'cnode'.
+ ?line Pid ! Term,
+ ?line receive
+ Term2 ->
+ io:format("received ~p~n", [Term2]),
+ case Term2 of
+ Term ->
+ {Ref22,_,_} = Term2,
+ ?line check_ref(Ref22);
+ X ->
+ test_server:fail({receive1,X})
+ end
+ after 5000 ->
+ test_server:fail(receive1)
+ end,
+ ?line receive
+ Pid ->
+ ok;
+ Y ->
+ test_server:fail({receive1,Y})
+ after 5000 ->
+ test_server:fail(receive2)
+ end,
+ ?line io:format("ref = ~p~n", [Ref1]),
+ ?line check_ref(Ref1),
+ ok.
+
+check_ref(Ref) ->
+ case bin_ext_type(Ref) of
+ 101 ->
+ test_server:fail(oldref);
+ 114 ->
+ ok;
+ Type ->
+ test_server:fail({type, Type})
+ end.
+
+bin_ext_type(T) ->
+ [131, Type | _] = binary_to_list(term_to_binary(T)),
+ Type.
+
+get_ref() ->
+ receive
+ X when is_reference(X) ->
+ X
+ after 5000 ->
+ test_server:fail({cnode, timeout})
+ end.
+
+start_cnode(Cnode) ->
+ open_port({spawn, Cnode ++ " " ++ atom_to_list(erlang:get_cookie())}, []),
+ rec_cnode().
+
+rec_cnode() ->
+ receive
+ X ->
+ io:format("from cnode: ~p~n", [X]),
+ rec_cnode()
+ end.
+
+nc2vinfo(Pid) when is_pid(Pid) ->
+ ?line [_NodeStr, NumberStr, SerialStr]
+ = string:tokens(pid_to_list(Pid), "<.>"),
+ ?line Number = list_to_integer(NumberStr),
+ ?line Serial = list_to_integer(SerialStr),
+ ?line {pid, node(Pid), Number, Serial};
+nc2vinfo(Port) when is_port(Port) ->
+ ?line ["#Port", _NodeStr, NumberStr]
+ = string:tokens(erlang:port_to_list(Port), "<.>"),
+ ?line Number = list_to_integer(NumberStr),
+ ?line {port, node(Port), Number};
+nc2vinfo(Ref) when is_reference(Ref) ->
+ ?line ["#Ref", _NodeStr | NumStrList]
+ = string:tokens(erlang:ref_to_list(Ref), "<.>"),
+ ?line {Len, RevNumList} = lists:foldl(fun ("0", {N, []}) ->
+ {N+1, []};
+ (IStr, {N, Is}) ->
+ {N+1,
+ [list_to_integer(IStr)|Is]}
+ end,
+ {0, []},
+ NumStrList),
+ ?line {ref, node(Ref), Len, lists:reverse(RevNumList)};
+nc2vinfo(Other) ->
+ ?line {badarg, Other}.
+
+
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..0f25fcc0a9
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2000-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+eterm_test_decl.c: eterm_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run eterm_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..89931c7701
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src
@@ -0,0 +1,50 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @erl_interface_sock_libs@ @LIBS@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+ETERM_OBJS = eterm_test@obj@ eterm_test_decl@obj@
+CNODE_OBJS = cnode@obj@
+PRINT_OBJS = print_term@obj@
+EXE_FILES = eterm_test@exe@ print_term@exe@ cnode@exe@
+
+all: $(EXE_FILES)
+
+eterm_test@exe@: $(ETERM_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(ETERM_OBJS) $(LIBFLAGS)
+
+cnode@exe@: $(CNODE_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(CNODE_OBJS) $(LIBFLAGS)
+
+print_term@exe@: print_term@obj@ $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(PRINT_OBJS) $(LIBFLAGS)
+
+clean:
+ $(RM) $(ETERM_OBJS) $(CNODE_OBJS) $(PRINT_OBJS)
+ $(RM) $(EXE_FILES)
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c b/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c
new file mode 100644
index 0000000000..133f35f4bd
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c
@@ -0,0 +1,166 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1999-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "ei.h"
+#include "erl_interface.h"
+
+#define MSGSIZE 13
+
+#define SELF(fd) erl_mk_pid(erl_thisnodename(),fd,0,erl_thiscreation())
+
+#ifdef VXWORKS
+#define MAIN cnode
+#else
+#define MAIN main
+#endif
+
+/* FIXME uses mix och ei and erl_interface */
+
+/*
+ A small cnode.
+ To be called from the test case erl_eterm_SUITE:cnode_1.
+
+ 1) Set up connection to node 'test_server' on the same host.
+ All sends are done to a registered process named 'mip'.
+ 2) Create a long ref and send it.
+ 3) Create a pid for ourselves and send it.
+ 4) Receive a message.
+ 5) Send back the message part of the message.
+ 6) Send back the 'to' part of the message.
+ 7) Exit.
+*/
+
+MAIN(int argc, char **argv)
+
+{
+ unsigned char *msgbufp;
+ int msgsize;
+ ErlMessage msg;
+ char msgbuf[MSGSIZE];
+ char buf[100];
+ char buf1[100];
+ char buf2[100];
+ int ix;
+ int s;
+ int fd;
+ char node[80];
+ char server[80];
+ char host[80];
+ int number;
+ ETERM *ref, *ref1, *ref2;
+
+ erl_init(NULL, 0);
+
+ number = 1;
+ if (argc >= 2) {
+ s = erl_connect_init(number, argv[1], 0);
+ } else {
+ s = erl_connect_init(number, (char *) 0, 0);
+ }
+ gethostname(host, sizeof(host));
+ sprintf(node, "c%d@%s", number, host);
+
+ printf("s = %d\n", s);
+
+ sprintf(server, "test_server@%s", host);
+ fd = erl_connect(server);
+ printf("fd = %d\n", fd);
+
+/* printf("dist = %d\n", erl_distversion(fd)); */
+
+#if 1
+ ref = erl_mk_long_ref(node, 4711, 113, 98, 0);
+#else
+ ref = erl_mk_ref(node, 4711, 0);
+#endif
+ printf("ref = %d\n", ref);
+
+ s = erl_reg_send(fd, "mip", ref);
+ printf("s = %d\n", s);
+
+ {
+ ETERM* emsg;
+ emsg = SELF(fd);
+ erl_reg_send(fd,"mip",emsg);
+ erl_free_term(emsg);
+ }
+
+ msgsize = 4;
+ msgbufp = (unsigned char *) malloc(msgsize);
+
+ do {
+#if 0
+ s = erl_receive_msg(fd, msgbuf, MSGSIZE, &msg);
+#else
+ s = erl_xreceive_msg(fd, &msgbufp, &msgsize, &msg);
+#endif
+ switch (s) {
+ case ERL_TICK:
+ printf("tick\n");
+ break;
+ case ERL_ERROR:
+ printf("error\n");
+ break;
+ case ERL_MSG:
+ printf("msg %d\n", msgsize);
+ break;
+ default:
+ printf("unknown result %d\n", s);
+ break;
+ }
+ } while (s == ERL_TICK);
+
+ s = erl_reg_send(fd, "mip", msg.msg);
+ printf("s = %d\n", s);
+ s = erl_reg_send(fd, "mip", msg.to);
+ printf("s = %d\n", s);
+#if 0
+ /* from = NULL! */
+ s = erl_reg_send(fd, "mip", msg.from);
+ printf("s = %d\n", s);
+#endif
+
+#if 0
+ /* Unused code which tests refs in some ways. */
+ ix = 0;
+ s = ei_encode_term(buf, &ix, ref);
+ printf ("ei encode = %d, ix = %d\n", s, ix);
+
+ /* Compare old and new ref equal */
+ ref1 = erl_mk_long_ref(node, 4711, 113, 98, 0);
+ ref2 = erl_mk_ref(node, 4711, 0);
+ s = erl_encode(ref1, buf1);
+ printf("enc1 s = %d\n", s);
+ s = erl_encode(ref2, buf2);
+ printf("enc2 s = %d\n", s);
+ s = erl_compare_ext(buf1, buf2);
+ printf("comp s = %d\n", s);
+
+ /* Compare, in another way */
+ s = erl_match(ref1, ref2);
+ printf("match s = %d\n", s);
+#endif
+
+ erl_close_connection(fd);
+
+ return 0;
+}
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
new file mode 100644
index 0000000000..6b2ec8f766
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
@@ -0,0 +1,1511 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Tests the functions in erl_eterm.c and erl_malloc.c.
+ * Author: Bjorn Gustavsson
+ *
+ * See the erl_eterm_SUITE.erl file for a "table of contents".
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+#include "runner.h"
+
+/*
+ * Find out which version of erl_interface we are using.
+ */
+
+#ifdef ERL_IS_STRING
+#undef NEW_ERL_INTERFACE
+#else
+#define NEW_ERL_INTERFACE
+#endif
+
+void dump_term (FILE *fp, ETERM *t);
+
+static ETERM* all_types();
+
+/***********************************************************************
+ *
+ * 1. B a s i c t e s t s
+ *
+ ***********************************************************************/
+
+/*
+ * Sends a list contaning all data types to the Erlang side.
+ */
+
+TESTCASE(build_terms)
+{
+ ETERM* t;
+
+ erl_init(NULL, 0);
+ t = all_types();
+ send_term(t);
+ report(1);
+}
+
+/*
+ * Converts an Erlang term to the external term format and back again.
+ */
+
+TESTCASE(round_trip_conversion)
+{
+ ETERM* original;
+ ETERM* new_terms;
+ char encoded[16*1024];
+ int n;
+
+ erl_init(NULL, 0);
+ original = all_types();
+ if (erl_encode(original, encoded) == 0)
+ {
+ fail("failed to encode terms");
+ } else if ((new_terms = erl_decode(encoded)) == NULL)
+ {
+ fail("failed to decode terms");
+ } else if (!erl_match(original, new_terms))
+ {
+ fail("decoded terms didn't match original");
+ }
+
+ erl_free_term(original);
+ erl_free_term(new_terms);
+ report(1);
+}
+
+/*
+ * Decodes data from the Erlang side and verifies.
+ */
+
+TESTCASE(decode_terms)
+{
+ ETERM* terms;
+ char* message;
+
+ erl_init(NULL, 0);
+ terms = get_term();
+ if (terms == NULL) {
+ fail("unexpected end of file");
+ } else {
+ ETERM* all;
+ ETERM* p;
+ ETERM* t;
+ int i;
+
+ all = p = all_types();
+ t = terms;
+
+ /*
+ * XXX For now, skip the reference, pid, and port, because
+ * the match will fail. Must write code here to do some other
+ * validating.
+ */
+
+ for (i=0; i<6; i++) {
+
+ p = erl_tl(p);
+ t = erl_tl(t);
+ erl_free_term(p);
+ erl_free_term(t);
+
+ }
+
+ /*
+ * Match the tail of the lists.
+ */
+
+ if (!erl_match(p, t))
+ {
+ fail("Received terms didn't match expected");
+ }
+ erl_free_term(all);
+ erl_free_term(terms);
+ report(1);
+ }
+}
+
+/*
+ * Decodes a float from the Erlang side and verifies.
+ */
+
+TESTCASE(decode_float)
+{
+ ETERM* afnum;
+ ETERM* efnum;
+ int result;
+
+ erl_init(NULL, 0);
+ afnum = get_term();
+ efnum = erl_mk_float(3.1415);
+ result = erl_match(efnum, afnum);
+ erl_free_term(afnum);
+ erl_free_term(efnum);
+ report(result);
+}
+
+/*
+ * Tests the erl_free_compound() function.
+ */
+
+TESTCASE(t_erl_free_compound)
+{
+ ETERM* t;
+
+ erl_init(NULL, 0);
+
+ t = all_types();
+ erl_free_compound(t);
+ report(1);
+}
+
+
+/***********************************************************************
+ *
+ * 2. C o n s t r u c t i n g t e r m s
+ *
+ ***********************************************************************/
+
+/*
+ * Makes various integers, and sends them to Erlang for verification.
+ */
+
+TESTCASE(t_erl_mk_int)
+{
+#define SEND_INT(i) \
+ do { \
+ ETERM* t = erl_mk_int(i); \
+ send_term(t); \
+ } while (0);
+
+ erl_init(NULL, 0);
+
+ SEND_INT(0);
+ SEND_INT(127);
+ SEND_INT(128);
+ SEND_INT(255);
+ SEND_INT(256);
+
+ SEND_INT(0xFFFF);
+ SEND_INT(0x10000);
+
+ SEND_INT(0x07FFFFFF);
+ SEND_INT(0x0FFFFFFF);
+ SEND_INT(0x1FFFFFFF);
+ SEND_INT(0x3FFFFFFF);
+ SEND_INT(0x7FFFFFFF);
+
+ SEND_INT(0x08000000);
+ SEND_INT(0x10000000);
+ SEND_INT(0x20000000);
+ SEND_INT(0x40000000);
+
+ SEND_INT(-0x07FFFFFF);
+ SEND_INT(-0x0FFFFFFF);
+ SEND_INT(-0x1FFFFFFF);
+ SEND_INT(-0x3FFFFFFF);
+ SEND_INT(-0x7FFFFFFF);
+
+ SEND_INT(-0x08000000);
+ SEND_INT(-0x10000000);
+ SEND_INT(-0x20000000);
+ SEND_INT(-0x40000000);
+
+ SEND_INT(-0x08000001);
+ SEND_INT(-0x10000001);
+ SEND_INT(-0x20000001);
+ SEND_INT(-0x40000001);
+
+ SEND_INT(-0x08000002);
+ SEND_INT(-0x10000002);
+ SEND_INT(-0x20000002);
+ SEND_INT(-0x40000002);
+
+ SEND_INT(-1999999999);
+ SEND_INT(-2000000000);
+ SEND_INT(-2000000001);
+
+ report(1);
+}
+
+
+/*
+ * Makes lists of various sizes, and sends them to Erlang for verification.
+ */
+
+TESTCASE(t_erl_mk_list)
+{
+ ETERM* a[4];
+
+ erl_init(NULL, 0);
+
+ /*
+ * Empty list.
+ */
+
+ send_term(erl_mk_list(a, 0));
+
+ /*
+ * One element: [abc]
+ */
+
+ a[0] = erl_mk_atom("abc");
+ send_term(erl_mk_list(a, 1));
+ erl_free_term(a[0]);
+
+ /*
+ * Two elements: [abcdef, 42].
+ */
+
+ a[0] = erl_mk_atom("abcdef");
+ a[1] = erl_mk_int(42);
+ send_term(erl_mk_list(a, 2));
+ erl_free_term(a[0]);
+ erl_free_term(a[1]);
+
+ /*
+ * Four elements.
+ */
+
+ a[0] = erl_mk_float(0.0);
+ a[1] = erl_mk_int(23);
+ a[2] = erl_mk_empty_list();
+ a[3] = erl_mk_float(3.1415);
+ send_term(erl_mk_list(a, 4));
+ erl_free_term(a[0]);
+ erl_free_term(a[1]);
+ erl_free_term(a[2]);
+ erl_free_term(a[3]);
+
+ report(1);
+}
+
+/*
+ * A basic test of erl_copy_term().
+ */
+
+TESTCASE(basic_copy)
+{
+ ETERM* original;
+ ETERM* copy;
+ int result;
+
+ erl_init(NULL, 0);
+ original = all_types();
+ copy = erl_copy_term(original);
+ if (copy == NULL) {
+ fail("erl_copy_term() failed");
+ } else if (!erl_match(original, copy))
+ {
+ fail("copy doesn't match original");
+ }
+
+ erl_free_term(original);
+ erl_free_term(copy);
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_atom().
+ */
+
+TESTCASE(t_erl_mk_atom)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_atom("madonna"));
+ send_term(erl_mk_atom("Madonna"));
+ send_term(erl_mk_atom("mad donna"));
+ send_term(erl_mk_atom("_madonna_"));
+ send_term(erl_mk_atom("/home/madonna/tour_plan"));
+ send_term(erl_mk_atom("http://www.madonna.com/tour_plan"));
+ send_term(erl_mk_atom("\'madonna\'"));
+ send_term(erl_mk_atom("\"madonna\""));
+ send_term(erl_mk_atom("\\madonna\\"));
+ send_term(erl_mk_atom("{madonna,21,'mad donna',12}"));
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_binary().
+ */
+
+TESTCASE(t_erl_mk_binary)
+{
+
+ char* string;
+ erl_init(NULL, 0);
+
+ string = "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}";
+ send_term(erl_mk_binary(string,strlen(string)));
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_empty_list().
+ */
+
+TESTCASE(t_erl_mk_empty_list)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_empty_list());
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_float().
+ */
+
+TESTCASE(t_erl_mk_float)
+{
+ ETERM* arr[6];
+ ETERM* emsg;
+
+ erl_init(NULL, 0);
+
+ arr[0] = erl_mk_float(3.1415);
+ arr[1] = erl_mk_float(1.999999);
+ arr[2] = erl_mk_float(2.000000);
+ arr[3] = erl_mk_float(2.000001);
+ arr[4] = erl_mk_float(2.000002);
+ arr[5] = erl_mk_float(12345.67890);
+ emsg = (erl_mk_tuple(arr,6));
+
+ send_term(emsg);
+
+ erl_free_array(arr,6);
+ /* emsg already freed by send_term() */
+ /* erl_free_term(emsg); */
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_pid().
+ */
+
+TESTCASE(t_erl_mk_pid)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_pid("kalle@localhost", 3, 2, 1));
+ report(1);
+}
+
+/*
+ * A basic test of erl_mk_pid().
+ */
+
+TESTCASE(t_erl_mk_xpid)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_pid("kalle@localhost", 32767, 8191, 1));
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_port().
+ */
+
+TESTCASE(t_erl_mk_port)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_port("kalle@localhost", 4, 1));
+ report(1);
+}
+
+/*
+ * A basic test of erl_mk_port().
+ */
+
+TESTCASE(t_erl_mk_xport)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_port("kalle@localhost", 268435455, 1));
+ report(1);
+}
+
+/*
+ * A basic test of erl_mk_ref().
+ */
+
+TESTCASE(t_erl_mk_ref)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_ref("kalle@localhost", 6, 1));
+ report(1);
+}
+
+/*
+ * A basic test of erl_mk_long_ref().
+ */
+
+
+TESTCASE(t_erl_mk_long_ref)
+{
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_long_ref("kalle@localhost",
+ 4294967295, 4294967295, 262143,
+ 1));
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_string().
+ */
+
+TESTCASE(t_erl_mk_string)
+{
+
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_string("madonna"));
+ send_term(erl_mk_string("Madonna"));
+ send_term(erl_mk_string("mad donna"));
+ send_term(erl_mk_string("_madonna_"));
+ send_term(erl_mk_string("/home/madonna/tour_plan"));
+ send_term(erl_mk_string("http://www.madonna.com/tour_plan"));
+ send_term(erl_mk_string("\'madonna\'"));
+ send_term(erl_mk_string("\"madonna\""));
+ send_term(erl_mk_string("\\madonna\\"));
+ send_term(erl_mk_string("{madonna,21,'mad donna',12}"));
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_estring().
+ */
+
+TESTCASE(t_erl_mk_estring)
+{
+ char* string;
+ erl_init(NULL, 0);
+
+ string = "madonna";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "Madonna";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "mad donna";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "_madonna_";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "/home/madonna/tour_plan";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "http://www.madonna.com/tour_plan";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "\'madonna\'";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "\"madonna\"";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "\\madonna\\";
+ send_term(erl_mk_estring(string,strlen(string)));
+ string = "{madonna,21,'mad donna',12}";
+ send_term(erl_mk_estring(string,strlen(string)));
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_tuple().
+ */
+
+TESTCASE(t_erl_mk_tuple)
+{
+ ETERM* arr[4];
+ ETERM* arr2[2];
+ ETERM* arr3[2];
+ ETERM* arr4[2];
+
+ erl_init(NULL, 0);
+
+ /* {madonna,21,'mad donna',12} */
+ arr[0] = erl_mk_atom("madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_atom("mad donna");
+ arr[3] = erl_mk_int(12);
+
+ send_term(erl_mk_tuple(arr,4));
+
+ erl_free_array(arr,4);
+
+
+ /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */
+ arr4[0] = erl_mk_atom("home page");
+ arr4[1] = erl_mk_string("http://www.madonna.com/");
+
+ arr3[0] = erl_mk_string("Isabella");
+ arr3[1] = erl_mk_int(2);
+
+ arr2[0] = erl_mk_atom("children");
+ arr2[1] = erl_mk_tuple(arr3,2);
+
+ arr[0] = erl_mk_atom("Madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_tuple(arr2,2);
+ arr[3] = erl_mk_tuple(arr4,2);
+
+ send_term(erl_mk_tuple(arr,4));
+
+ erl_free_array(arr,4);
+ erl_free_array(arr2,2);
+ erl_free_array(arr3,2);
+ erl_free_array(arr4,2);
+
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_uint().
+ */
+
+TESTCASE(t_erl_mk_uint)
+{
+ unsigned i;
+
+ erl_init(NULL, 0);
+
+ send_term(erl_mk_uint(54321));
+ i = 2147483647;
+ send_term(erl_mk_uint(i));
+ send_term(erl_mk_uint(i+1));
+ send_term(erl_mk_uint(i+2));
+ send_term(erl_mk_uint(i+3));
+ send_term(erl_mk_uint(i+i+1));
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_mk_var().
+ */
+
+TESTCASE(t_erl_mk_var)
+{
+ ETERM* mk_var;
+ ETERM* term;
+ ETERM* term2;
+ ETERM* arr[4];
+ ETERM* arr_term[2];
+ ETERM* mk_var_tuple;
+ ETERM* term_tuple;
+
+ erl_init(NULL, 0);
+
+
+ /* match unbound/bound variable against an integer */
+ term = erl_mk_int(17);
+ term2 = erl_mk_int(2);
+ mk_var = erl_mk_var("New_var");
+ send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
+ send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */
+ send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
+ send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */
+ erl_free_term(mk_var);
+ erl_free_term(term);
+ erl_free_term(term2);
+
+ /* match unbound variable against a tuple */
+ arr[0] = erl_mk_atom("madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_atom("mad donna");
+ arr[3] = erl_mk_int(12);
+ mk_var = erl_mk_var("New_var");
+ term = erl_mk_tuple(arr,4);
+ send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
+ erl_free_term(mk_var);
+ erl_free_term(term);
+ erl_free_array(arr,4);
+
+
+ /* match (twice) unbound variable against an incorrect tuple */
+ arr[0] = erl_mk_var("New_var");
+ arr[1] = erl_mk_var("New_var");
+ arr_term[0] = erl_mk_int(17);
+ arr_term[1] = erl_mk_int(27);
+ mk_var_tuple = erl_mk_tuple(arr,2);
+ term_tuple = erl_mk_tuple(arr_term,2);
+ send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should fail */
+ erl_free_array(arr,2);
+ erl_free_array(arr_term,2);
+ erl_free_term(mk_var_tuple);
+ erl_free_term(term_tuple);
+
+
+ /* match (twice) unbound variable against a correct tuple */
+ arr[0] = erl_mk_var("New_var");
+ arr[1] = erl_mk_var("New_var");
+ arr_term[0] = erl_mk_int(17);
+ arr_term[1] = erl_mk_int(17);
+ mk_var_tuple = erl_mk_tuple(arr,2);
+ term_tuple = erl_mk_tuple(arr_term,2);
+ send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should be ok */
+ erl_free_array(arr,2);
+ erl_free_array(arr_term,2);
+ erl_free_term(mk_var_tuple);
+ erl_free_term(term_tuple);
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_size().
+ */
+
+TESTCASE(t_erl_size)
+{
+ ETERM* arr[4];
+ ETERM* tuple;
+ ETERM* bin;
+ char* string;
+
+ erl_init(NULL, 0);
+
+ /* size of a tuple */
+ tuple = erl_format("{}");
+ send_term(erl_mk_int(erl_size(tuple)));
+ erl_free_term(tuple);
+
+ arr[0] = erl_mk_atom("madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_atom("mad donna");
+ arr[3] = erl_mk_int(12);
+ tuple = erl_mk_tuple(arr,4);
+
+ send_term(erl_mk_int(erl_size(tuple)));
+
+ erl_free_array(arr,4);
+ erl_free_term(tuple);
+
+ /* size of a binary */
+ string = "";
+ bin = erl_mk_binary(string,strlen(string));
+ send_term(erl_mk_int(erl_size(bin)));
+ erl_free_term(bin);
+
+ string = "{madonna,21,'mad donna',12}";
+ bin = erl_mk_binary(string,strlen(string));
+ send_term(erl_mk_int(erl_size(bin)));
+ erl_free_term(bin);
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_var_content().
+ */
+
+TESTCASE(t_erl_var_content)
+{
+ ETERM* mk_var;
+ ETERM* term;
+ ETERM* tuple;
+ ETERM* list;
+ ETERM* a;
+ ETERM* b;
+ ETERM* arr[4];
+ ETERM* arr2[2];
+ ETERM* arr3[2];
+ ETERM* arr4[2];
+
+ erl_init(NULL, 0);
+
+ term = erl_mk_int(17);
+ mk_var = erl_mk_var("Var");
+
+ /* unbound, should return NULL */
+ if (erl_var_content(mk_var,"Var") != NULL)
+ fail("t_erl_var_content() failed");
+
+ erl_match(mk_var, term);
+ send_term(erl_var_content(mk_var,"Var")); /* should return 17 */
+
+ /* integer, should return NULL */
+ if (erl_var_content(term,"Var") != NULL)
+ fail("t_erl_var_content() failed");
+
+ /* unknown variable, should return NULL */
+ if (erl_var_content(mk_var,"Unknown_Var") != NULL)
+ fail("t_erl_var_content() failed");
+
+ erl_free_term(mk_var);
+ erl_free_term(term);
+
+ /* {'Madonna',21,{children,{"Name","Age"}},{"Home_page","Tel_no"}} */
+ arr4[0] = erl_mk_var("Home_page");
+ arr4[1] = erl_mk_var("Tel_no");
+ a = erl_mk_string("http://www.madonna.com");
+ erl_match(arr4[0], a);
+
+ arr3[0] = erl_mk_var("Name");
+ arr3[1] = erl_mk_var("Age");
+ b = erl_mk_int(2);
+ erl_match(arr3[1], b);
+
+ arr2[0] = erl_mk_atom("children");
+ arr2[1] = erl_mk_tuple(arr3,2);
+
+ arr[0] = erl_mk_atom("Madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_tuple(arr2,2);
+ arr[3] = erl_mk_tuple(arr4,2);
+
+ tuple = erl_mk_tuple(arr,4);
+
+ /* should return "http://www.madonna.com" */
+ send_term(erl_var_content(tuple,"Home_page"));
+
+ /* unbound, should return NULL */
+ if (erl_var_content(tuple,"Tel_no") != NULL)
+ fail("t_erl_var_content() failed");
+
+ /* unbound, should return NULL */
+ if (erl_var_content(tuple,"Name") != NULL)
+ fail("t_erl_var_content() failed");
+
+ /* should return 2 */
+ send_term(erl_var_content(tuple,"Age"));
+
+ erl_free_array(arr,4);
+ erl_free_array(arr2,2);
+ erl_free_array(arr3,2);
+ erl_free_array(arr4,2);
+ erl_free_term(tuple);
+ erl_free_term(a);
+ erl_free_term(b);
+
+
+ /* [] */
+ list = erl_mk_empty_list();
+ if (erl_var_content(list,"Tel_no") != NULL)
+ fail("t_erl_var_content() failed");
+ erl_free_term(list);
+
+
+ /* ['Madonna',[],{children,{"Name","Age"}},{"Home_page","Tel_no"}] */
+ arr4[0] = erl_mk_var("Home_page");
+ arr4[1] = erl_mk_var("Tel_no");
+ a = erl_mk_string("http://www.madonna.com");
+ erl_match(arr4[0], a);
+
+ arr3[0] = erl_mk_var("Name");
+ arr3[1] = erl_mk_var("Age");
+ b = erl_mk_int(2);
+ erl_match(arr3[1], b);
+
+ arr2[0] = erl_mk_atom("children");
+ arr2[1] = erl_mk_tuple(arr3,2);
+
+ arr[0] = erl_mk_atom("Madonna");
+ arr[1] = erl_mk_empty_list();
+ arr[2] = erl_mk_tuple(arr2,2);
+ arr[3] = erl_mk_tuple(arr4,2);
+
+ list = erl_mk_list(arr,4);
+
+ /* should return "http://www.madonna.com" */
+ send_term(erl_var_content(list,"Home_page"));
+
+ /* unbound, should return NULL */
+ if (erl_var_content(list,"Tel_no") != NULL)
+ fail("t_erl_var_content() failed");
+
+ /* unbound, should return NULL */
+ if (erl_var_content(list,"Name") != NULL)
+ fail("t_erl_var_content() failed");
+
+ /* should return 2 */
+ send_term(erl_var_content(list,"Age"));
+
+ erl_free_array(arr,4);
+ erl_free_array(arr2,2);
+ erl_free_array(arr3,2);
+ erl_free_array(arr4,2);
+ erl_free_term(list);
+ erl_free_term(a);
+ erl_free_term(b);
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_element().
+ */
+
+TESTCASE(t_erl_element)
+{
+ ETERM* arr[4];
+ ETERM* arr2[2];
+ ETERM* arr3[2];
+ ETERM* arr4[2];
+ ETERM* tuple;
+
+ erl_init(NULL, 0);
+
+ arr[0] = erl_mk_atom("madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_atom("mad donna");
+ arr[3] = erl_mk_int(12);
+ tuple = erl_mk_tuple(arr,4);
+
+ send_term(erl_element(1,tuple));
+ send_term(erl_element(2,tuple));
+ send_term(erl_element(3,tuple));
+ send_term(erl_element(4,tuple));
+
+ erl_free_array(arr,4);
+ erl_free_term(tuple);
+
+ /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */
+ arr4[0] = erl_mk_atom("home page");
+ arr4[1] = erl_mk_string("http://www.madonna.com/");
+
+ arr3[0] = erl_mk_string("Isabella");
+ arr3[1] = erl_mk_int(2);
+
+ arr2[0] = erl_mk_atom("children");
+ arr2[1] = erl_mk_tuple(arr3,2);
+
+ arr[0] = erl_mk_atom("Madonna");
+ arr[1] = erl_mk_int(21);
+ arr[2] = erl_mk_tuple(arr2,2);
+ arr[3] = erl_mk_tuple(arr4,2);
+
+ tuple = erl_mk_tuple(arr,4);
+ send_term(erl_element(1,tuple));
+ send_term(erl_element(2,tuple));
+ send_term(erl_element(3,tuple));
+ send_term(erl_element(4,tuple));
+
+ erl_free_term(tuple);
+ erl_free_array(arr,4);
+ erl_free_array(arr2,2);
+ erl_free_array(arr3,2);
+ erl_free_array(arr4,2);
+
+ report(1);
+}
+
+
+/*
+ * A basic test of erl_cons().
+ */
+
+TESTCASE(t_erl_cons)
+{
+ ETERM* list;
+ ETERM* anAtom;
+ ETERM* anInt;
+
+ erl_init(NULL, 0);
+
+ anAtom = erl_mk_atom("madonna");
+ anInt = erl_mk_int(21);
+ list = erl_mk_empty_list();
+ list = erl_cons(anInt, list);
+ send_term(erl_cons(anAtom, list));
+
+ erl_free_term(anAtom);
+ erl_free_term(anInt);
+ erl_free_compound(list);
+
+ report(1);
+}
+
+
+
+
+/***********************************************************************
+ *
+ * 3. E x t r a c t i n g & i n f o f u n c t i o n s
+ *
+ ***********************************************************************/
+
+/*
+ * Calculates the length of each list sent to it and sends back the result.
+ */
+
+TESTCASE(t_erl_length)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+ ETERM* len_term;
+
+ len_term = erl_mk_int(erl_length(term));
+ erl_free_term(term);
+ send_term(len_term);
+ }
+ }
+}
+
+/*
+ * Gets the head of each term and sends the result back.
+ */
+
+TESTCASE(t_erl_hd)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+ ETERM* head;
+
+ head = erl_hd(term);
+ send_term(head);
+ erl_free_term(term);
+ }
+ }
+}
+
+/*
+ * Gets the tail of each term and sends the result back.
+ */
+
+TESTCASE(t_erl_tl)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+ ETERM* tail;
+
+ tail = erl_tl(term);
+ send_term(tail);
+ erl_free_term(term);
+ }
+ }
+}
+
+/*
+ * Checks the type checking macros.
+ */
+
+TESTCASE(type_checks)
+{
+ ETERM* t;
+ ETERM* atom;
+
+ erl_init(NULL, 0);
+ atom = erl_mk_atom("an_atom");
+
+#define TYPE_CHECK(macro, term) \
+ { ETERM* t = term; \
+ if (macro(t)) { \
+ erl_free_term(t); \
+ } else { \
+ fail("Macro " #macro " failed on " #term); \
+ } \
+ }
+
+ TYPE_CHECK(ERL_IS_INTEGER, erl_mk_int(0x7FFFFFFF));
+#ifdef NEW_ERL_INTERFACE
+ TYPE_CHECK(ERL_IS_UNSIGNED_INTEGER, erl_mk_uint(0x7FFFFFFF));
+#endif
+ TYPE_CHECK(ERL_IS_FLOAT, erl_mk_float(5.5));
+ TYPE_CHECK(ERL_IS_ATOM, erl_mk_atom("another_atom"));
+
+ TYPE_CHECK(ERL_IS_EMPTY_LIST, erl_mk_empty_list());
+ TYPE_CHECK(!ERL_IS_EMPTY_LIST, erl_cons(atom, atom));
+
+#ifdef NEW_ERL_INTERFACE
+ TYPE_CHECK(!ERL_IS_CONS, erl_mk_empty_list());
+ TYPE_CHECK(ERL_IS_CONS, erl_cons(atom, atom));
+#endif
+
+ TYPE_CHECK(ERL_IS_LIST, erl_mk_empty_list());
+ TYPE_CHECK(ERL_IS_LIST, erl_cons(atom, atom));
+
+ TYPE_CHECK(ERL_IS_PID, erl_mk_pid("a@a", 42, 1, 1));
+ TYPE_CHECK(ERL_IS_PORT, erl_mk_port("a@a", 42, 1));
+ TYPE_CHECK(ERL_IS_REF, erl_mk_ref("a@a", 42, 1));
+
+ TYPE_CHECK(ERL_IS_BINARY, erl_mk_binary("a", 1));
+ TYPE_CHECK(ERL_IS_TUPLE, erl_mk_tuple(&atom, 1));
+#undef TYPE_CHECK
+
+ erl_free_term(atom);
+
+ report(1);
+}
+
+/*
+ * Checks the extractor macros.
+ */
+
+TESTCASE(extractor_macros)
+{
+ ETERM* t;
+
+ erl_init(NULL, 0);
+
+#ifdef NEW_ERL_INTERFACE
+#define MATCH(a, b) ((a) == (b) ? 1 : fail("bad match: " #a))
+#define STR_MATCH(a, b) (strcmp((a), (b)) ? fail("bad match: " #a) : 0)
+
+ { /* Integer */
+ int anInt = 0x7FFFFFFF;
+ t = erl_mk_int(anInt);
+ MATCH(ERL_INT_VALUE(t), anInt);
+ MATCH(ERL_INT_UVALUE(t), anInt);
+ erl_free_term(t);
+ }
+
+ { /* Float */
+ double aFloat = 3.1415;
+ t = erl_mk_float(aFloat);
+ MATCH(ERL_FLOAT_VALUE(t), aFloat);
+ erl_free_term(t);
+ }
+
+ { /* Atom. */
+ char* aString = "nisse";
+ t = erl_mk_atom(aString);
+ if (memcmp(ERL_ATOM_PTR(t), aString, strlen(aString)) != 0)
+ fail("bad match");
+ MATCH(ERL_ATOM_SIZE(t), strlen(aString));
+ erl_free_term(t);
+ }
+
+ { /* Pid. */
+ char* node = "arne@strider";
+ int number = 42;
+ int serial = 5;
+ int creation = 1;
+
+ t = erl_mk_pid(node, number, serial, creation);
+ STR_MATCH(ERL_PID_NODE(t), node);
+ MATCH(ERL_PID_NUMBER(t), number);
+ MATCH(ERL_PID_SERIAL(t), serial);
+ MATCH(ERL_PID_CREATION(t), creation);
+ erl_free_term(t);
+ }
+
+ { /* Port. */
+ char* node = "kalle@strider";
+ int number = 45;
+ int creation = 1;
+
+ t = erl_mk_port(node, number, creation);
+ STR_MATCH(ERL_PORT_NODE(t), node);
+ MATCH(ERL_PORT_NUMBER(t), number);
+ MATCH(ERL_PORT_CREATION(t), creation);
+ erl_free_term(t);
+ }
+
+ { /* Reference. */
+ char* node = "kalle@strider";
+ int number = 48;
+ int creation = 1;
+
+ t = erl_mk_ref(node, number, creation);
+ STR_MATCH(ERL_REF_NODE(t), node);
+ MATCH(ERL_REF_NUMBER(t), number);
+ MATCH(ERL_REF_CREATION(t), creation);
+ erl_free_term(t);
+ }
+
+ { /* Tuple. */
+ ETERM* arr[2];
+
+ arr[0] = erl_mk_int(51);
+ arr[1] = erl_mk_int(52);
+ t = erl_mk_tuple(arr, ASIZE(arr));
+ MATCH(ERL_TUPLE_SIZE(t), ASIZE(arr));
+ MATCH(ERL_TUPLE_ELEMENT(t, 0), arr[0]);
+ MATCH(ERL_TUPLE_ELEMENT(t, 1), arr[1]);
+ erl_free_array(arr, ASIZE(arr));
+ erl_free_term(t);
+ }
+
+ { /* Binary. */
+ static char bin[] = {1, 2, 3, 0, 4, 5};
+
+ t = erl_mk_binary(bin, ASIZE(bin));
+ MATCH(ERL_BIN_SIZE(t), ASIZE(bin));
+ if (memcmp(ERL_BIN_PTR(t), bin, ASIZE(bin)) != 0)
+ fail("bad match");
+ erl_free_term(t);
+ }
+
+ {
+ ETERM* head = erl_mk_atom("head");
+ ETERM* tail = erl_mk_atom("tail");
+
+ t = erl_cons(head, tail);
+ MATCH(ERL_CONS_HEAD(t), head);
+ MATCH(ERL_CONS_TAIL(t), tail);
+ erl_free_term(head);
+ erl_free_term(tail);
+ erl_free_term(t);
+ }
+#undef MATCH
+#undef STR_MATCH
+#endif
+
+ report(1);
+}
+
+
+
+/***********************************************************************
+ *
+ * 4. I / O l i s t f u n c t i o n s
+ *
+ ***********************************************************************/
+
+/*
+ * Invokes erl_iolist_length() on each term and send backs the result.
+ */
+
+TESTCASE(t_erl_iolist_length)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+#ifndef NEW_ERL_INTERFACE
+ fail("Function not present in this version of erl_interface");
+#else
+ ETERM* len_term;
+
+ len_term = erl_mk_int(erl_iolist_length(term));
+ erl_free_term(term);
+ send_term(len_term);
+#endif
+ }
+ }
+}
+
+/*
+ * Invokes erl_iolist_to_binary() on each term and send backs the result.
+ */
+
+TESTCASE(t_erl_iolist_to_binary)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+#ifndef NEW_ERL_INTERFACE
+ fail("Function not present in this version of erl_interface");
+#else
+ ETERM* new_term;
+
+ new_term = erl_iolist_to_binary(term);
+
+ erl_free_term(term);
+ send_term(new_term);
+#endif
+ }
+ }
+}
+
+/*
+ * Invokes erl_iolist_to_string() on each term and send backs the result.
+ */
+
+TESTCASE(t_erl_iolist_to_string)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+#ifndef NEW_ERL_INTERFACE
+ fail("Function not present in this version of erl_interface");
+#else
+ char* result;
+
+ result = erl_iolist_to_string(term);
+ erl_free_term(term);
+ if (result != NULL) {
+ send_buffer(result, strlen(result)+1);
+ erl_free(result);
+ } else {
+ send_term(NULL);
+ }
+#endif
+ }
+ }
+}
+
+
+/***********************************************************************
+ *
+ * 5. M i s c e l l a n o u s T e s t s
+ *
+ ***********************************************************************/
+
+/*
+ * Test some combinations of operations to verify that the reference pointers
+ * are handled correctly.
+ *
+ * "Det verkar vara lite High Chaparal med minneshanteringen i erl_interface"
+ * Per Lundgren, ERV.
+ */
+
+TESTCASE(high_chaparal)
+{
+ ETERM *L1, *A1, *L2, *A2, *L3;
+
+ erl_init(NULL, 0);
+
+ L1 = erl_mk_empty_list();
+ A1 = erl_mk_atom("world");
+ L2 = erl_cons(A1, L1);
+ A2 = erl_mk_atom("hello");
+ L3 = erl_cons(A2, L2);
+
+ erl_free_term(L1);
+ erl_free_term(A1);
+ erl_free_term(L2);
+ erl_free_term(A2);
+
+ send_term(L3);
+
+ /* already freed by send_term() */
+ /* erl_free_term(L3);*/
+
+ report(1);
+}
+
+/*
+ * Test erl_decode to recover from broken list data (OTP-7448)
+ */
+TESTCASE(broken_data)
+{
+ ETERM* original;
+ ETERM* new_terms;
+ char encoded[16*1024];
+ int n;
+
+ erl_init(NULL, 0);
+ original = all_types();
+ if ((n=erl_encode(original, encoded)) == 0)
+ {
+ fail("failed to encode terms");
+ } else
+ {
+ int offs = n/2;
+ memset(encoded+offs,0,n-offs); /* destroy */
+
+ if ((new_terms = erl_decode(encoded)) != NULL)
+ {
+ fail("decode accepted broken data");
+ erl_free_term(new_terms);
+ }
+ }
+ erl_free_term(original);
+ report(1);
+}
+
+/*
+ * Returns a list containing instances of all types.
+ *
+ * Be careful changing the contents of the list returned, because both
+ * the build_terms() and decode_terms() test cases depend on it.
+ */
+
+static ETERM*
+all_types(void)
+{
+ ETERM* t;
+ ETERM* terms[3];
+ int i;
+ static char a_binary[] = "A binary";
+
+#define CONS_AND_FREE(expr, tail) \
+ do { \
+ ETERM* term = expr; \
+ ETERM* nl = erl_cons(term, tail); \
+ erl_free_term(term); \
+ erl_free_term(tail); \
+ tail = nl; \
+ } while (0)
+
+ t = erl_mk_empty_list();
+
+ CONS_AND_FREE(erl_mk_atom("I am an atom"), t);
+ CONS_AND_FREE(erl_mk_binary("A binary", sizeof(a_binary)-1), t);
+ CONS_AND_FREE(erl_mk_float(3.0), t);
+ CONS_AND_FREE(erl_mk_int(0), t);
+ CONS_AND_FREE(erl_mk_int(-1), t);
+ CONS_AND_FREE(erl_mk_int(1), t);
+
+ CONS_AND_FREE(erl_mk_string("A string"), t);
+
+ terms[0] = erl_mk_atom("element1");
+ terms[1] = erl_mk_int(42);
+ terms[2] = erl_mk_int(767);
+ CONS_AND_FREE(erl_mk_tuple(terms, ASIZE(terms)), t);
+ for (i = 0; i < ASIZE(terms); i++) {
+ erl_free_term(terms[i]);
+ }
+
+ CONS_AND_FREE(erl_mk_pid("kalle@localhost", 3, 2, 1), t);
+ CONS_AND_FREE(erl_mk_pid("abcdefghijabcdefghij@localhost", 3, 2, 1), t);
+ CONS_AND_FREE(erl_mk_port("kalle@localhost", 4, 1), t);
+ CONS_AND_FREE(erl_mk_port("abcdefghijabcdefghij@localhost", 4, 1), t);
+ CONS_AND_FREE(erl_mk_ref("kalle@localhost", 6, 1), t);
+ CONS_AND_FREE(erl_mk_ref("abcdefghijabcdefghij@localhost", 6, 1), t);
+ return t;
+
+#undef CONS_AND_FREE
+}
+
+/*
+ * Dump (print for debugging) a term. Useful if/when things go wrong.
+ */
+void
+dump_term (FILE *fp, ETERM *t)
+{
+ if (fp == NULL) return;
+
+ fprintf(fp, "#<%p ", t);
+
+ if(t != NULL)
+ {
+ fprintf(fp, "count:%d, type:%d", ERL_COUNT(t), ERL_TYPE(t));
+
+ switch(ERL_TYPE(t))
+ {
+ case ERL_UNDEF:
+ fprintf(fp, "==undef");
+ break;
+ case ERL_INTEGER:
+ fprintf(fp, "==int, val:%d", ERL_INT_VALUE(t));
+ break;
+ case ERL_U_INTEGER:
+ fprintf(fp, "==uint, val:%u", ERL_INT_UVALUE(t));
+ break;
+ case ERL_FLOAT:
+ fprintf(fp, "==float, val:%g", ERL_FLOAT_VALUE(t));
+ break;
+ case ERL_ATOM:
+ fprintf(fp, "==atom, name:%p \"%s\"",
+ ERL_ATOM_PTR(t), ERL_ATOM_PTR(t));
+ break;
+ case ERL_BINARY:
+ fprintf(fp, "==binary, data:%p,%u",
+ ERL_BIN_PTR(t), ERL_BIN_SIZE(t));
+ break;
+ case ERL_PID:
+ fprintf(fp, "==pid, node:%p \"%s\"",
+ ERL_PID_NODE(t), ERL_PID_NODE(t));
+ break;
+ case ERL_PORT:
+ fprintf(fp, "==port, node:%p \"%s\"",
+ ERL_PORT_NODE(t), ERL_PORT_NODE(t));
+ break;
+ case ERL_REF:
+ fprintf(fp, "==ref, node:%p \"%s\"",
+ ERL_REF_NODE(t), ERL_REF_NODE(t));
+ break;
+ case ERL_CONS:
+ fprintf(fp, "==cons");
+ fprintf(fp, ", car:");
+ dump_term(fp, ERL_CONS_HEAD(t));
+ fprintf(fp, ", cdr:");
+ dump_term(fp, ERL_CONS_TAIL(t));
+ break;
+ case ERL_NIL:
+ fprintf(fp, "==nil");
+ break;
+ case ERL_TUPLE:
+ fprintf(fp, "==tuple, elems:%p,%u",
+ ERL_TUPLE_ELEMS(t), ERL_TUPLE_SIZE(t));
+ {
+ size_t i;
+ for(i = 0; i < ERL_TUPLE_SIZE(t); i++)
+ {
+ fprintf(fp, "elem[%u]:", i);
+ dump_term(fp, ERL_TUPLE_ELEMENT(t, i));
+ }
+ }
+ break;
+ case ERL_VARIABLE:
+ fprintf(fp, "==variable, name:%p \"%s\"",
+ ERL_VAR_NAME(t), ERL_VAR_NAME(t));
+ fprintf(fp, ", value:");
+ dump_term(fp, ERL_VAR_VALUE(t));
+ break;
+
+ default:
+ break;
+ }
+ }
+ fprintf(fp, ">");
+}
+
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c b/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c
new file mode 100644
index 0000000000..56e2d43d2f
--- /dev/null
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c
@@ -0,0 +1,129 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Test the erl_print_term() function.
+ * Author: Bjorn Gustavsson
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#ifndef __WIN32__
+#include <unistd.h>
+#endif
+
+#include "erl_interface.h"
+
+#ifndef __WIN32__
+#define _O_BINARY 0
+#define _setmode(fd, mode)
+#endif
+
+#define HEADER_SIZE 2
+
+static int readn(int, unsigned char*, int);
+
+/*
+ * This program doesn't use the runner, because it needs a packet
+ * on input, but the result will be as a stream of bytes (since
+ * erl_print_term() prints directly on a file).
+ *
+ * Input is a package of with a packet header size of two bytes.
+ *
+ * +------------------------------------------------------------+
+ * | length | Encoded term... |
+ * | (2 bytes) | (as given by "length") |
+ * +------------------------------------------------------------+
+ *
+ * <------------------- length --------------------->
+ *
+ * This program decodes the encoded terms and passes it to
+ * erl_print_term(). Then this program prints
+ *
+ * CR <result> LF
+ *
+ * and waits for a new package. <result> is the return value from
+ * erl_print_term(), formatted as an ASCII string.
+ */
+
+#ifdef VXWORKS
+int print_term()
+#else
+int main()
+#endif
+{
+ _setmode(0, _O_BINARY);
+ _setmode(1, _O_BINARY);
+
+ erl_init(NULL, 0);
+
+ for (;;) {
+ char buf[4*1024];
+ ETERM* term;
+ char* message;
+ int n;
+
+ if (readn(0, buf, 2) <= 0) {
+ /* fprintf(stderr, "error reading message header\n"); */
+ /* actually this is where we leave the infinite loop */
+ exit(1);
+ }
+ n = buf[0] * 256 + buf[1];
+ if (readn(0, buf, n) < 0) {
+ fprintf(stderr, "error reading message contents\n");
+ exit(1);
+ }
+
+ term = erl_decode(buf);
+ if (term == NULL) {
+ fprintf(stderr, "erl_decode() failed\n");
+ exit(1);
+ }
+ n = erl_print_term(stdout, term);
+ erl_free_compound(term);
+ fprintf(stdout,"\r%d\n", n);
+ fflush(stdout);
+ }
+}
+
+/*
+ * Reads len number of bytes.
+ */
+
+static int
+readn(fd, buf, len)
+ int fd; /* File descriptor to read from. */
+ unsigned char *buf; /* Store in this buffer. */
+ int len; /* Number of bytes to read. */
+{
+ int n; /* Byte count in last read call. */
+ int sofar = 0; /* Bytes read so far. */
+
+ do {
+ if ((n = read(fd, buf+sofar, len-sofar)) <= 0)
+ /* error or EOF in read */
+ return(n);
+ sofar += n;
+ } while (sofar < len);
+ return sofar;
+}
+
diff --git a/lib/erl_interface/test/erl_ext_SUITE.erl b/lib/erl_interface/test/erl_ext_SUITE.erl
new file mode 100644
index 0000000000..dbafea0e39
--- /dev/null
+++ b/lib/erl_interface/test/erl_ext_SUITE.erl
@@ -0,0 +1,81 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_ext_SUITE).
+
+-include("test_server.hrl").
+-include("erl_ext_SUITE_data/ext_test_cases.hrl").
+
+-export([
+ all/1,
+ compare_tuple/1,
+ compare_list/1,
+ compare_string/1,
+ compare_list_string/1,
+ compare_nc_ext/1
+ ]).
+
+-import(runner, [get_term/1]).
+
+all(suite) -> [
+ compare_tuple,
+ compare_list,
+ compare_string,
+ compare_list_string,
+ compare_nc_ext
+ ].
+
+compare_tuple(suite) -> [];
+compare_tuple(doc) -> [];
+compare_tuple(Config) when is_list(Config) ->
+ ?line P = runner:start(?compare_tuple),
+ ?line runner:recv_eot(P),
+ ok.
+
+compare_list(suite) -> [];
+compare_list(doc) -> [];
+compare_list(Config) when is_list(Config) ->
+ ?line P = runner:start(?compare_list),
+ ?line runner:recv_eot(P),
+ ok.
+
+compare_string(suite) -> [];
+compare_string(doc) -> [];
+compare_string(Config) when is_list(Config) ->
+ ?line P = runner:start(?compare_string),
+ ?line runner:recv_eot(P),
+ ok.
+
+compare_list_string(suite) -> [];
+compare_list_string(doc) -> [];
+compare_list_string(Config) when is_list(Config) ->
+ ?line P = runner:start(?compare_list_string),
+ ?line runner:recv_eot(P),
+ ok.
+
+compare_nc_ext(suite) -> [];
+compare_nc_ext(doc) -> [];
+compare_nc_ext(Config) when is_list(Config) ->
+ ?line P = runner:start(?compare_nc_ext),
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
diff --git a/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..cb7b12cc79
--- /dev/null
+++ b/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2002-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ext_test_decl.c: ext_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run ext_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..6f363ccd6f
--- /dev/null
+++ b/lib/erl_interface/test/erl_ext_SUITE_data/Makefile.src
@@ -0,0 +1,41 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2002-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+EXT_OBJS = ext_test@obj@ ext_test_decl@obj@
+
+all: ext_test@exe@
+
+clean:
+ $(RM) $(EXT_OBJS)
+ $(RM) ext_test@exe@
+
+ext_test@exe@: $(EXT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(EXT_OBJS) $(LIBFLAGS)
diff --git a/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c
new file mode 100644
index 0000000000..ba1a6c66da
--- /dev/null
+++ b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c
@@ -0,0 +1,485 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ *
+
+ */
+/*
+ * Author: Rickard Green
+ * Modified: Bj�rn-Egil Dahlberg
+ * - compare_tuple
+ * - compare_string
+ * - compare_list
+ * - compare_list and string
+ */
+
+#include "runner.h"
+#include "erl_interface.h"
+#include <stdio.h>
+#include <string.h>
+
+typedef unsigned int uint;
+
+#define MAX_NC_EXT_SIZE 100
+
+static unsigned char *
+write_pid(unsigned char *buf, char *node, uint cre, uint ser, uint num);
+static unsigned char *
+write_port(unsigned char *buf, char *node, uint cre, uint id);
+static unsigned char *
+write_ref(unsigned char *buf, char *node, uint cre, uint id[], uint no_ids);
+static void
+test_compare_ext(char *test_desc,
+ unsigned char *ext1,
+ unsigned char *end_ext1,
+ unsigned char *ext2,
+ unsigned char *end_ext2,
+ int exp_res);
+
+/*
+ * Test erl_compare_ext with tuples
+ */
+TESTCASE(compare_tuple) {
+ // erlang:term_to_binary ({'b'})
+ unsigned char term1[] = { 131, 104, 1, 100, 0, 1, 98 };
+ // erlang:term_to_binary ({'a', 'a'})
+ unsigned char term2[] = { 131, 104, 2, 100, 0, 1, 97, 100, 0, 1, 97 };
+ unsigned char *start_a, *start_b, *end_a, *end_b;
+
+ erl_init(NULL, 0);
+ start_a = term1;
+ start_b = term2;
+ end_a = term1 + 7;
+ end_b = term2 + 11;
+
+ test_compare_ext("tuples", start_a, end_a, start_b, end_b, -1);
+
+ report(1);
+}
+
+/*
+ * Test erl_compare_ext with lists
+ */
+
+TESTCASE(compare_list) {
+ unsigned char *start_a, *start_b, *end_a, *end_b;
+ // erlang:term_to_binary([a,b,[],3412])
+ unsigned char term1[] = {131,108,0,0,0,4,100,0,1,97,100,0,1,98,106,98,0,0,13,84,106};
+ // erlang:term_to_binary([34,{a,n},a,erlang])
+ unsigned char term2[] = {131,108,0,0,0,4,97,34,104,2,100,0,1,97,100,0,1,110,100,0,1,97,100,0,6,101,114,108,97,110,103,106};
+
+ erl_init(NULL, 0);
+ start_a = term1;
+ start_b = term2;
+ end_a = term1 + 21;
+ end_b = term2 + 32;
+
+ test_compare_ext("lists", start_a, end_a, start_b, end_b, 1);
+
+ report(1);
+}
+
+/*
+ * Test erl_compare_ext with strings
+ */
+
+TESTCASE(compare_string) {
+ unsigned char *start_a, *start_b, *end_a, *end_b;
+ // erlang:term_to_binary("hej")
+ unsigned char term1[] = {131,107,0,3,104,101,106};
+ // erlang:term_to_binary("erlang")
+ unsigned char term2[] = {131,107,0,6,101,114,108,97,110,103};
+
+ erl_init(NULL, 0);
+ start_a = term1;
+ start_b = term2;
+ end_a = term1 + 7;
+ end_b = term2 + 10;
+
+ test_compare_ext("strings", start_a, end_a, start_b, end_b, 1);
+
+ report(1);
+}
+
+/*
+ * Test erl_compare_ext with lists and strings
+ */
+
+TESTCASE(compare_list_string) {
+ unsigned char *start_a, *start_b, *end_a, *end_b;
+ // erlang:term_to_binary("hej")
+ unsigned char term1[] = {131,107,0,3,104,101,106};
+ // erlang:term_to_binary([a,b,[],3412])
+ unsigned char term2[] = {131,108,0,0,0,4,100,0,1,97,100,0,1,98,106,98,0,0,13,84,106};
+
+ erl_init(NULL, 0);
+ start_a = term1;
+ start_b = term2;
+ end_a = term1 + 7;
+ end_b = term2 + 21;
+
+ test_compare_ext("strings", start_a, end_a, start_b, end_b, -1);
+
+ report(1);
+}
+
+
+
+/*
+ * Test erl_compare_ext with node containers
+ */
+TESTCASE(compare_nc_ext)
+{
+ int res;
+ unsigned char buf_a[MAX_NC_EXT_SIZE], buf_b[MAX_NC_EXT_SIZE];
+ unsigned char *end_a, *end_b;
+ uint id[3];
+
+ erl_init(NULL, 0);
+
+
+ /*
+ * Test pids ----------------------------------------------------
+ *
+ * Significance (most -> least):
+ * nodename, creation, serial, number, nodename, creation
+ *
+ */
+
+ end_a = write_pid(buf_a, "b@b", 2, 4711, 1);
+
+ end_b = write_pid(buf_b, "a@b", 1, 4710, 2);
+ test_compare_ext("pid test 1", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_pid(buf_b, "a@b", 1, 4712, 1);
+ test_compare_ext("pid test 2", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_pid(buf_b, "c@b", 1, 4711, 1);
+ test_compare_ext("pid test 3", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_pid(buf_b, "b@b", 3, 4711, 1);
+ test_compare_ext("pid test 4", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_pid(buf_b, "b@b", 2, 4711, 1);
+ test_compare_ext("pid test 5", buf_a, end_a, buf_b, end_b, 0);
+
+
+ /*
+ * Test ports ---------------------------------------------------
+ *
+ * Significance (most -> least):
+ * nodename, creation, number
+ *
+ * OBS: Comparison between ports has changed in R9. This
+ * since it wasn't stable in R8 (and eariler releases).
+ * Significance used to be: dist_slot, number,
+ * creation.
+ */
+
+ end_a = write_port(buf_a, "b@b", 2, 4711),
+
+ end_b = write_port(buf_b, "c@b", 1, 4710);
+ test_compare_ext("port test 1", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_port(buf_b, "b@b", 3, 4710);
+ test_compare_ext("port test 2", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_port(buf_b, "b@b", 2, 4712);
+ test_compare_ext("port test 3", buf_a, end_a, buf_b, end_b, -1);
+
+ end_b = write_port(buf_b, "b@b", 2, 4711);
+ test_compare_ext("port test 4", buf_a, end_a, buf_b, end_b, 0);
+
+ /*
+ * Test refs ----------------------------------------------------
+ * Significance (most -> least):
+ * nodename, creation, (number high, number mid), number low,
+ *
+ * OBS: Comparison between refs has changed in R9. This
+ * since it wasn't stable in R8 (and eariler releases).
+ * Significance used to be: dist_slot, number,
+ * creation.
+ *
+ */
+
+ /* Long & Long */
+
+ id[0] = 4711; id[1] = 4711, id[2] = 4711;
+ end_a = write_ref(buf_a, "b@b", 2, id, 3);
+
+
+ id[0] = 4710; id[1] = 4710; id[2] = 4710;
+ end_b = write_ref(buf_b, "c@b", 1, id, 3);
+ test_compare_ext("ref test 1", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710; id[1] = 4710; id[2] = 4710;
+ end_b = write_ref(buf_b, "b@b", 3, id, 3);
+ test_compare_ext("ref test 2", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710; id[1] = 4710; id[2] = 4712;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 3", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710; id[1] = 4712; id[2] = 4711;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 4", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4712; id[1] = 4711; id[2] = 4711;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 5", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4711; id[1] = 4711; id[2] = 4711;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 6", buf_a, end_a, buf_b, end_b, 0);
+
+ /* Long & Short */
+ id[0] = 4711; id[1] = 0, id[2] = 0;
+ end_a = write_ref(buf_a, "b@b", 2, id, 3);
+
+
+ id[0] = 4710;
+ end_b = write_ref(buf_b, "c@b", 1, id, 1);
+ test_compare_ext("ref test 7", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710;
+ end_b = write_ref(buf_b, "b@b", 3, id, 1);
+ test_compare_ext("ref test 8", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4712;
+ end_b = write_ref(buf_b, "b@b", 2, id, 1);
+ test_compare_ext("ref test 9", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4711;
+ end_b = write_ref(buf_b, "b@b", 2, id, 1);
+ test_compare_ext("ref test 10", buf_a, end_a, buf_b, end_b, 0);
+
+ /* Short & Long */
+ id[0] = 4711;
+ end_a = write_ref(buf_a, "b@b", 2, id, 1);
+
+
+ id[0] = 4710; id[1] = 0, id[2] = 0;
+ end_b = write_ref(buf_b, "c@b", 1, id, 3);
+ test_compare_ext("ref test 11", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710; id[1] = 0, id[2] = 0;
+ end_b = write_ref(buf_b, "b@b", 3, id, 3);
+ test_compare_ext("ref test 12", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4712; id[1] = 0, id[2] = 0;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 13", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4711; id[1] = 0, id[2] = 0;
+ end_b = write_ref(buf_b, "b@b", 2, id, 3);
+ test_compare_ext("ref test 14", buf_a, end_a, buf_b, end_b, 0);
+
+ /* Short & Short */
+ id[0] = 4711;
+ end_a = write_ref(buf_a, "b@b", 2, id, 1);
+
+
+ id[0] = 4710;
+ end_b = write_ref(buf_b, "c@b", 1, id, 1);
+ test_compare_ext("ref test 15", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4710;
+ end_b = write_ref(buf_b, "b@b", 3, id, 1);
+ test_compare_ext("ref test 16", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4712;
+ end_b = write_ref(buf_b, "b@b", 2, id, 1);
+ test_compare_ext("ref test 17", buf_a, end_a, buf_b, end_b, -1);
+
+ id[0] = 4711;
+ end_b = write_ref(buf_b, "b@b", 2, id, 1);
+ test_compare_ext("ref test 18", buf_a, end_a, buf_b, end_b, 0);
+
+ report(1);
+}
+
+static void
+test_compare_ext(char *test_desc,
+ unsigned char *ext1,
+ unsigned char *end_ext1,
+ unsigned char *ext2,
+ unsigned char *end_ext2,
+ int exp_res)
+{
+ int er, ar;
+ unsigned char *e1, *e2;
+ int reversed_args;
+ char ext_str[MAX_NC_EXT_SIZE*4 + 1];
+ char *es;
+
+ message("*** %s ***", test_desc);
+ message(" erl_compare_ext() arguments:", test_desc);
+
+ es = &ext_str[0];
+
+ e1 = ext1;
+ while (e1 < end_ext1)
+ es += sprintf(es, "%d,", *(e1++));
+ *(--es) = '\0';
+ message(" e1 = <<%s>>", ext_str);
+
+
+ es = &ext_str[0];
+
+ e2 = ext2;
+ while (e2 < end_ext2)
+ es += sprintf(es, "%d,", *(e2++));
+ *(--es) = '\0';
+ message(" e2 = <<%s>>", ext_str);
+
+ message("Starting %s...", test_desc);
+
+
+ reversed_args = 0;
+ er = exp_res;
+ e1 = ext1;
+ e2 = ext2;
+
+ reversed_args_start:
+
+ ar = erl_compare_ext(e1, e2);
+ if (er < 0) {
+ if (ar > 0)
+ fail("expected result e1 < e2; actual result e1 > e2\n");
+ else if (ar == 0)
+ fail("expected result e1 < e2; actual result e1 = e2\n");
+ }
+ else if (er > 0) {
+ if (ar < 0)
+ fail("expected result e1 > e2; actual result e1 < e2\n");
+ else if (ar == 0)
+ fail("expected result e1 > e2; actual result e1 = e2\n");
+ }
+ else {
+ if (ar > 0)
+ fail("expected result e1 = e2; actual result e1 > e2\n");
+ else if (ar < 0)
+ fail("expected result e1 = e2; actual result e1 < e2\n");
+ }
+
+ message("%s", "SUCCEEDED!");
+ if (!reversed_args) {
+ message("Starting %s with reversed arguments...", test_desc);
+ e2 = ext1;
+ e1 = ext2;
+ if (exp_res < 0)
+ er = 1;
+ else if (exp_res > 0)
+ er = -1;
+ reversed_args = 1;
+ goto reversed_args_start;
+ }
+
+ message("%s", "");
+
+}
+
+
+#define ATOM_EXT (100)
+#define REFERENCE_EXT (101)
+#define PORT_EXT (102)
+#define PID_EXT (103)
+#define NEW_REFERENCE_EXT (114)
+
+
+#define PUT_UINT16(E, X) ((E)[0] = ((X) >> 8) & 0xff, \
+ (E)[1] = (X) & 0xff)
+
+#define PUT_UINT32(E, X) ((E)[0] = ((X) >> 24) & 0xff, \
+ (E)[1] = ((X) >> 16) & 0xff, \
+ (E)[2] = ((X) >> 8) & 0xff, \
+ (E)[3] = (X) & 0xff)
+
+static unsigned char *
+write_atom(unsigned char *buf, char *atom)
+{
+ uint len;
+
+ len = 0;
+ while(atom[len]) {
+ buf[len + 3] = atom[len];
+ len++;
+ }
+ buf[0] = ATOM_EXT;
+ PUT_UINT16(&buf[1], len);
+
+ return buf + 3 + len;
+}
+
+static unsigned char *
+write_pid(unsigned char *buf, char *node, uint cre, uint num, uint ser)
+{
+ unsigned char *e = buf;
+
+ *(e++) = PID_EXT;
+ e = write_atom(e, node);
+ PUT_UINT32(e, num & ((1 << 15) - 1));
+ e += 4;
+ PUT_UINT32(e, ser & ((1 << 3) - 1));
+ e += 4;
+ *(e++) = cre & ((1 << 2) - 1);
+
+ return e;
+}
+
+static unsigned char *
+write_port(unsigned char *buf, char *node, uint cre, uint id)
+{
+ unsigned char *e = buf;
+
+ *(e++) = PORT_EXT;
+ e = write_atom(e, node);
+ PUT_UINT32(e, id & ((1 << 15) - 1));
+ e += 4;
+ *(e++) = cre & ((1 << 2) - 1);
+
+ return e;
+}
+
+static unsigned char *
+write_ref(unsigned char *buf, char *node, uint cre, uint id[], uint no_ids)
+{
+ int i;
+ unsigned char *e = buf;
+
+ if (no_ids == 1) {
+ *(e++) = REFERENCE_EXT;
+ e = write_atom(e, node);
+ PUT_UINT32(e, id[0] & ((1 << 15) - 1));
+ e += 4;
+ *(e++) = cre & ((1 << 2) - 1);
+ }
+ else {
+ *(e++) = NEW_REFERENCE_EXT;
+ PUT_UINT16(e, no_ids);
+ e += 2;
+ e = write_atom(e, node);
+ *(e++) = cre & ((1 << 2) - 1);
+ for (i = 0; i < no_ids; i++) {
+ PUT_UINT32(e, id[i]);
+ e += 4;
+ }
+ }
+
+ return e;
+}
+
diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl
new file mode 100644
index 0000000000..81a0bca80f
--- /dev/null
+++ b/lib/erl_interface/test/erl_format_SUITE.erl
@@ -0,0 +1,136 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_format_SUITE).
+
+-include("test_server.hrl").
+-include("erl_format_SUITE_data/format_test_cases.hrl").
+
+-export([all/1, atoms/1, tuples/1, lists/1]).
+
+-import(runner, [get_term/1]).
+
+%% This test suite test the erl_format() function.
+%% It uses the port program "format_test".
+
+all(suite) -> [atoms, tuples, lists].
+
+%% Tests formatting various atoms.
+
+atoms(suite) -> [];
+atoms(Config) when is_list(Config) ->
+ ?line P = runner:start(?atoms),
+
+ ?line {term, ''} = get_term(P),
+ ?line {term, 'a'} = get_term(P),
+ ?line {term, 'A'} = get_term(P),
+ ?line {term, 'abc'} = get_term(P),
+ ?line {term, 'Abc'} = get_term(P),
+ ?line {term, 'ab@c'} = get_term(P),
+ ?line {term, 'The rain in Spain stays mainly in the plains'} =
+ get_term(P),
+
+ ?line {term, a} = get_term(P),
+ ?line {term, ab} = get_term(P),
+ ?line {term, abc} = get_term(P),
+ ?line {term, ab@c} = get_term(P),
+ ?line {term, abcdefghijklmnopq} = get_term(P),
+
+ ?line {term, ''} = get_term(P),
+ ?line {term, 'a'} = get_term(P),
+ ?line {term, 'A'} = get_term(P),
+ ?line {term, 'abc'} = get_term(P),
+ ?line {term, 'Abc'} = get_term(P),
+ ?line {term, 'ab@c'} = get_term(P),
+ ?line {term, 'The rain in Spain stays mainly in the plains'} =
+ get_term(P),
+
+ ?line {term, a} = get_term(P),
+ ?line {term, ab} = get_term(P),
+ ?line {term, abc} = get_term(P),
+ ?line {term, ab@c} = get_term(P),
+ ?line {term, ' abcdefghijklmnopq '} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various tuples
+
+tuples(suite) -> [];
+tuples(Config) when is_list(Config) ->
+ ?line P = runner:start(?tuples),
+
+ ?line {term, {}} = get_term(P),
+ ?line {term, {a}} = get_term(P),
+ ?line {term, {a, b}} = get_term(P),
+ ?line {term, {a, b, c}} = get_term(P),
+ ?line {term, {1}} = get_term(P),
+ ?line {term, {[]}} = get_term(P),
+ ?line {term, {[], []}} = get_term(P),
+ ?line {term, {[], a, b, c}} = get_term(P),
+ ?line {term, {[], a, [], b, c}} = get_term(P),
+ ?line {term, {[], a, '', b, c}} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
+%% Tests formatting various lists
+
+lists(suite) -> [];
+lists(Config) when is_list(Config) ->
+ ?line P = runner:start(?lists),
+
+ ?line {term, []} = get_term(P),
+ ?line {term, [a]} = get_term(P),
+ ?line {term, [a, b]} = get_term(P),
+ ?line {term, [a, b, c]} = get_term(P),
+ ?line {term, [1]} = get_term(P),
+ ?line {term, [[]]} = get_term(P),
+ ?line {term, [[], []]} = get_term(P),
+ ?line {term, [[], a, b, c]} = get_term(P),
+ ?line {term, [[], a, [], b, c]} = get_term(P),
+ ?line {term, [[], a, '', b, c]} = get_term(P),
+
+ ?line {term, [{name, 'Madonna'}, {age, 21}, {data, [{addr, "E-street", 42}]}]} =
+ get_term(P),
+ case os:type() of
+ vxworks ->
+ ?line {term, [{pi, _}, {'cos(70)', _}]} = get_term(P),
+ ?line {term, [[pi, _], ['cos(70)', _]]} = get_term(P),
+ ?line {term, [[pi, _], [], ["cos(70)", _]]} =
+ get_term(P);
+ _ ->
+ ?line {term, [{pi, 3.1415}, {'cos(70)', 0.34202}]} = get_term(P),
+ ?line {term, [[pi, 3.1415], ['cos(70)', 0.34202]]} = get_term(P),
+ ?line {term, [[pi, 3.1415], [], ["cos(70)", 0.34202]]} =
+ get_term(P)
+ end,
+
+ ?line {term, [-1]} = get_term(P),
+
+ ?line runner:recv_eot(P),
+ ok.
+
+
+
diff --git a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..2cd313a324
--- /dev/null
+++ b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2000-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+format_test_decl.c: format_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run format_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..0cd1ab512d
--- /dev/null
+++ b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src
@@ -0,0 +1,43 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+FORMAT_OBJS = format_test@obj@ format_test_decl@obj@
+
+all: format_test@exe@
+
+clean:
+ $(RM) $(FORMAT_OBJS)
+ $(RM) format_test@exe@
+
+format_test@exe@: $(FORMAT_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(FORMAT_OBJS) $(LIBFLAGS)
+
+
diff --git a/lib/erl_interface/test/erl_format_SUITE_data/format_test.c b/lib/erl_interface/test/erl_format_SUITE_data/format_test.c
new file mode 100644
index 0000000000..75e73b6df5
--- /dev/null
+++ b/lib/erl_interface/test/erl_format_SUITE_data/format_test.c
@@ -0,0 +1,132 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "runner.h"
+
+/*
+ * Purpose: Tests the erl_format() function.
+ * Author: Bjorn Gustavsson
+ */
+
+static void
+send_format(char* format)
+{
+ send_term(erl_format(format));
+}
+
+TESTCASE(atoms)
+{
+ erl_init(NULL, 0);
+
+ send_format("''");
+ send_format("'a'");
+ send_format("'A'");
+ send_format("'abc'");
+ send_format("'Abc'");
+ send_format("'ab@c'");
+ send_format("'The rain in Spain stays mainly in the plains'");
+
+ send_format("a");
+ send_format("ab");
+ send_format("abc");
+ send_format("ab@c");
+ send_format(" abcdefghijklmnopq ");
+
+ send_term(erl_format("~a", ""));
+ send_term(erl_format("~a", "a"));
+ send_term(erl_format("~a", "A"));
+ send_term(erl_format("~a", "abc"));
+ send_term(erl_format("~a", "Abc"));
+ send_term(erl_format("~a", "ab@c"));
+ send_term(erl_format("~a", "The rain in Spain stays mainly in the plains"));
+
+ send_term(erl_format("~a", "a"));
+ send_term(erl_format("~a", "ab"));
+ send_term(erl_format("~a", "abc"));
+ send_term(erl_format("~a","ab@c"));
+ send_term(erl_format("~a", " abcdefghijklmnopq "));
+
+
+ report(1);
+}
+
+TESTCASE(tuples)
+{
+ erl_init(NULL, 0);
+
+ send_format("{}");
+ send_format("{a}");
+ send_format("{a, b}");
+ send_format("{a, b, c}");
+ send_format("{1}");
+ send_format("{[]}");
+ send_format("{[], []}");
+ send_format("{[], a, b, c}");
+ send_format("{[], a, [], b, c}");
+ send_format("{[], a, '', b, c}");
+
+ report(1);
+}
+
+
+
+TESTCASE(lists)
+{
+ ETERM* a;
+ ETERM* b;
+ ETERM* c;
+
+ erl_init(NULL, 0);
+
+ send_format("[]");
+ send_format("[a]");
+ send_format("[a, b]");
+ send_format("[a, b, c]");
+ send_format("[1]");
+ send_format("[[]]");
+ send_format("[[], []]");
+ send_format("[[], a, b, c]");
+ send_format("[[], a, [], b, c]");
+ send_format("[[], a, '', b, c]");
+
+ b = erl_format("[{addr, ~s, ~i}]", "E-street", 42);
+ a = erl_format("[{name, ~a}, {age, ~i}, {data, ~w}]", "Madonna", 21, b);
+ send_term(a);
+ erl_free_term(b);
+
+ send_term(erl_format("[{pi, ~f}, {'cos(70)', ~f}]", 3.1415, 0.34202));
+
+ a = erl_mk_float(3.1415);
+ b = erl_mk_float(0.34202);
+ send_term(erl_format("[[pi, ~w], ['cos(70)', ~w]]", a, b));
+ erl_free_term(a);
+ erl_free_term(b);
+
+ a = erl_mk_float(3.1415);
+ b = erl_mk_float(0.34202);
+ c = erl_mk_empty_list();
+ send_term(erl_format("[[~a, ~w], ~w, [~s, ~w]]", "pi", a, c, "cos(70)", b));
+ erl_free_term(a);
+ erl_free_term(b);
+ erl_free_term(c);
+
+ send_term(erl_format("[~i]", -1));
+
+ report(1);
+}
diff --git a/lib/erl_interface/test/erl_interface.dynspec b/lib/erl_interface/test/erl_interface.dynspec
new file mode 100644
index 0000000000..8af5040d97
--- /dev/null
+++ b/lib/erl_interface/test/erl_interface.dynspec
@@ -0,0 +1,18 @@
+%% -*- erlang -*-
+%% You can test this file using this command.
+%% file:script("erl_interface.dynspec", [{'TestCCompiler',{msc | gnuc, undefined}}]).
+
+case {TestCCompiler, erlang:system_info(c_compiler_used)} of
+ {{CC, _}, {CC, _}} ->
+ [];
+ {{CC1, _}, {CC2, _}} when CC1 == msc; CC2 == msc ->
+ Comment =
+ "OTP's static C libraries (compiled with "
+ ++ atom_to_list(CC2) ++ ") aren't compatible "
+ "with the C compiler (" ++ atom_to_list(CC1)
+ ++ ") used for testing.",
+ StaticLibSuites = [all_SUITE],
+ lists:map(fun (Suite) -> {skip,{Suite, Comment}} end, StaticLibSuites);
+ {{CC1, _}, {CC2, _}} ->
+ []
+end.
diff --git a/lib/erl_interface/test/erl_interface.spec b/lib/erl_interface/test/erl_interface.spec
new file mode 100644
index 0000000000..2789bd3e2c
--- /dev/null
+++ b/lib/erl_interface/test/erl_interface.spec
@@ -0,0 +1,2 @@
+{topcase, {dir, "../erl_interface_test"}}.
+
diff --git a/lib/erl_interface/test/erl_interface.spec.vxworks b/lib/erl_interface/test/erl_interface.spec.vxworks
new file mode 100644
index 0000000000..7089b3d447
--- /dev/null
+++ b/lib/erl_interface/test/erl_interface.spec.vxworks
@@ -0,0 +1,5 @@
+{topcase, {dir, "../erl_interface_test"}}.
+{skip,{ei_accept_SUITE, ei_threaded_accept,
+ "Threaded test not yet implemented - FIXME"}}.
+{skip,{ei_connect_SUITE, ei_threaded_send,
+ "Threaded test not yet implemented - FIXME"}}.
diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl
new file mode 100644
index 0000000000..f506638544
--- /dev/null
+++ b/lib/erl_interface/test/erl_match_SUITE.erl
@@ -0,0 +1,288 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_match_SUITE).
+
+-include("test_server.hrl").
+-include("erl_match_SUITE_data/match_test_cases.hrl").
+
+-export([all/1, atoms/1, lists/1, tuples/1, references/1, pids/1, ports/1,
+ bind/1, integers/1, floats/1, binaries/1, strings/1]).
+
+%% For interactive running of matcher.
+-export([start_matcher/0, erl_match/3]).
+
+%% This test suite tests the erl_match() function.
+
+all(suite) -> [atoms, lists, tuples, references, pids, ports, bind,
+ integers, floats, binaries, strings].
+
+atoms(suite) -> [];
+atoms(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+
+ ?line eq(P, '', ''),
+ ?line eq(P, a, a),
+ ?line ne(P, a, b),
+ ?line ne(P, a, aa),
+ ?line eq(P, kalle, kalle),
+ ?line ne(P, kalle, arne),
+
+ ?line ne(P, kalle, 42),
+ ?line ne(P, 42, kalle),
+
+ ?line runner:finish(P),
+ ok.
+
+lists(suite) -> [];
+lists(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line eq(P, [], []),
+
+ ?line ne(P, [], [a]),
+ ?line ne(P, [a], []),
+
+ ?line eq(P, [a], [a]),
+ ?line ne(P, [a], [b]),
+
+ ?line eq(P, [a|b], [a|b]),
+ ?line ne(P, [a|b], [a|x]),
+
+ ?line eq(P, [a, b], [a, b]),
+ ?line ne(P, [a, b], [a, x]),
+
+ ?line eq(P, [a, b, c], [a, b, c]),
+ ?line ne(P, [a, b|c], [a, b|x]),
+ ?line ne(P, [a, b, c], [a, b, x]),
+ ?line ne(P, [a, b|c], [a, b|x]),
+ ?line ne(P, [a, x|c], [a, b|c]),
+ ?line ne(P, [a, b, c], [a, x, c]),
+
+ ?line runner:finish(P),
+ ok.
+
+tuples(suite) -> [];
+tuples(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+
+ ?line ne(P, {}, {a, b}),
+ ?line ne(P, {a, b}, {}),
+ ?line ne(P, {a}, {a, b}),
+ ?line ne(P, {a, b}, {a}),
+
+ ?line eq(P, {}, {}),
+
+ ?line eq(P, {a}, {a}),
+ ?line ne(P, {a}, {b}),
+
+ ?line eq(P, {1}, {1}),
+ ?line ne(P, {1}, {2}),
+
+ ?line eq(P, {a, b}, {a, b}),
+ ?line ne(P, {x, b}, {a, b}),
+
+ ?line ne(P, {error, x}, {error, y}),
+ ?line ne(P, {error, {undefined, {subscriber, last}}},
+ {error, {undefined, {subscriber, name}}}),
+
+ ?line runner:finish(P),
+ ok.
+
+
+references(suite) -> [];
+references(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line Ref1 = make_ref(),
+ ?line Ref2 = make_ref(),
+
+ ?line eq(P, Ref1, Ref1),
+ ?line eq(P, Ref2, Ref2),
+ ?line ne(P, Ref1, Ref2),
+ ?line ne(P, Ref2, Ref1),
+
+ ?line runner:finish(P),
+ ok.
+
+
+pids(suite) -> [];
+pids(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line Pid1 = c:pid(0,1,2),
+ ?line Pid2 = c:pid(0,1,3),
+
+ ?line eq(P, self(), self()),
+ ?line eq(P, Pid1, Pid1),
+ ?line ne(P, Pid1, self()),
+ ?line ne(P, Pid2, Pid1),
+
+ ?line runner:finish(P),
+ ok.
+
+
+ports(suite) -> [];
+ports(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skipped,"not on vxworks, pucko"};
+ _ ->
+ ?line P = start_matcher(),
+ ?line P2 = start_matcher(),
+
+ ?line eq(P, P, P),
+ ?line ne(P, P, P2),
+
+ ?line runner:finish(P),
+ ?line runner:finish(P2),
+ ok
+ end.
+
+integers(suite) -> [];
+integers(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line I1 = 123,
+ ?line I2 = 12345,
+ ?line I3 = -123,
+ ?line I4 = 2234,
+
+ ?line eq(P, I1, I1),
+ ?line eq(P, I2, I2),
+ ?line ne(P, I1, I2),
+ ?line ne(P, I1, I3),
+ ?line eq(P, I4, I4),
+
+ ?line runner:finish(P),
+ ok.
+
+
+
+floats(suite) -> [];
+floats(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line F1 = 3.1414,
+ ?line F2 = 3.1415,
+ ?line F3 = 3.1416,
+
+ ?line S1 = "string",
+ ?line S2 = "string2",
+
+ ?line eq(P, F1, F1),
+ ?line eq(P, F2, F2),
+ ?line ne(P, F1, F2),
+ ?line ne(P, F3, F2),
+
+ ?line eq(P, S2, S2),
+ ?line ne(P, S1, S2),
+
+ ?line runner:finish(P),
+ ok.
+
+
+
+binaries(suite) -> [];
+binaries(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+ ?line Bin1 = term_to_binary({kalle, 146015, {kungsgatan, 23}}),
+ ?line Bin2 = term_to_binary(sune),
+ ?line Bin3 = list_to_binary("sune"),
+
+ ?line eq(P, Bin1, Bin1),
+ ?line eq(P, Bin2, Bin2),
+ ?line eq(P, Bin3, Bin3),
+ ?line ne(P, Bin1, Bin2),
+ ?line ne(P, Bin1, Bin3),
+ ?line ne(P, Bin2, Bin3),
+
+ ?line runner:finish(P),
+ ok.
+
+
+
+strings(suite) -> [];
+strings(Config) when is_list(Config) ->
+ ?line P = start_matcher(),
+
+ ?line S1 = "string",
+ ?line S2 = "streng",
+ ?line S3 = "String",
+
+ ?line eq(P, S1, S1),
+ ?line ne(P, S1, S2),
+ ?line ne(P, S1, S3),
+
+ ?line runner:finish(P),
+ ok.
+
+
+
+bind(suite) -> [];
+bind(Config) when is_list(Config) ->
+ ?line P = start_bind(),
+ ?line S = "[X,Y,Z]",
+ ?line L1 = [301,302,302],
+ ?line L2 = [65,66,67],
+
+ ?line bind_ok(P, S, L1),
+ ?line bind_ok(P, S, L2),
+
+ ?line runner:finish(P),
+ ok.
+
+start_bind() ->
+ runner:start(?erl_match_bind).
+
+bind_ok(Port, Bind, Term) ->
+ true = erl_bind(Port, Bind, Term).
+
+%bind_nok(Port, Bind, Term) ->
+% false = erl_bind(Port, Bind, Term).
+
+erl_bind(Port, Pattern, Term) ->
+ Port ! {self(), {command, [$b, Pattern, 0]}},
+ runner:send_term(Port, Term),
+ case runner:get_term(Port) of
+ {term, 0} -> false;
+ {term, 1} -> true
+ end.
+
+
+
+
+
+
+start_matcher() ->
+ runner:start(?erl_match_server).
+
+eq(Port, Pattern, Term) ->
+ true = erl_match(Port, Pattern, Term).
+
+ne(Port, Pattern, Term) ->
+ false = erl_match(Port, Pattern, Term).
+
+
+
+erl_match(Port, Pattern, Term) ->
+ runner:send_term(Port, Pattern),
+ runner:send_term(Port, Term),
+ case runner:get_term(Port) of
+ {term, 0} -> false;
+ {term, 1} -> true
+ end.
+
+
diff --git a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..12141d210c
--- /dev/null
+++ b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2000-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+match_test_decl.c: match_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run match_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..8ce6c9c985
--- /dev/null
+++ b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src
@@ -0,0 +1,42 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+MATCH_OBJS = match_test@obj@ match_test_decl@obj@
+
+all: match_test@exe@
+
+clean:
+ $(RM) $(MATCH_OBJS)
+ $(RM) match_test@exe@
+
+match_test@exe@: $(MATCH_OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(MATCH_OBJS) $(LIBFLAGS)
+
diff --git a/lib/erl_interface/test/erl_match_SUITE_data/match_test.c b/lib/erl_interface/test/erl_match_SUITE_data/match_test.c
new file mode 100644
index 0000000000..153a528b0b
--- /dev/null
+++ b/lib/erl_interface/test/erl_match_SUITE_data/match_test.c
@@ -0,0 +1,113 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Purpose: Tests the erl_match() function.
+ * Author: Bjorn Gustavsson
+ */
+
+#include "runner.h"
+
+TESTCASE(erl_match_server)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ ETERM* pattern;
+ ETERM* term;
+
+ pattern = get_term();
+ if (pattern == NULL) {
+ report(1);
+ return;
+ } else {
+ term = get_term();
+ if (term == NULL) {
+ fail("Unexpected EOF term");
+ } else {
+ send_term(erl_mk_int(erl_match(pattern, term)));
+ erl_free_term(pattern);
+ erl_free_term(term);
+ }
+ }
+ }
+
+}
+
+TESTCASE(erl_match_bind)
+{
+ erl_init(NULL, 0);
+
+ for (;;) {
+ char* pattern;
+ ETERM* term;
+
+ pattern=read_packet(NULL);
+
+ switch (pattern[0]) {
+ case 'e':
+ free(pattern);
+ report(1);
+ return;
+
+ case 'b':
+ {
+ ETERM* patt_term;
+
+ /*
+ * Get the pattern string and convert it using erl_format().
+ *
+ * Note that the call to get_term() below destroys the buffer
+ * that the pattern variable points to. Therefore, it is
+ * essential to call erl_format() here, before
+ * calling get_term().
+ */
+
+ message("Pattern: %s", pattern+1);
+ patt_term = erl_format(pattern+1);
+ free(pattern);
+
+ if (patt_term == NULL) {
+ fail("erl_format() failed");
+ }
+
+ /*
+ * Get the term and send back the result of the erl_match()
+ * call.
+ */
+
+ term = get_term();
+ if (term == NULL) {
+ fail("Unexpected eof term");
+ }
+ else {
+ send_term(erl_mk_int(erl_match(patt_term, term)));
+ }
+ erl_free_term(patt_term);
+ erl_free_term(term);
+ }
+ break;
+
+ default:
+ free(pattern);
+ fail("Illegal character received");
+ }
+
+ }
+}
diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl
new file mode 100644
index 0000000000..895e29ad2e
--- /dev/null
+++ b/lib/erl_interface/test/port_call_SUITE.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(port_call_SUITE).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Checks if the dynamic driver and linker loader works.
+%%%
+%%% These tests can only be run installed (outside clearcase).
+%%%
+%%% XXX In this suite is missing test cases for reference counts
+%%% and that drivers are unloaded when their processes die.
+%%% (For me to add :-)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+-export([all/1, basic/1]).
+% Private exports
+-include("test_server.hrl").
+
+
+all(suite) ->
+ [basic].
+
+basic(suite) -> [];
+basic(Config) when is_list(Config) ->
+ case os:type() of
+ {unix, sunos} ->
+ do_basic(Config);
+ {win32,_} ->
+ do_basic(Config);
+ _ ->
+ {skipped, "Dynamic linking and erl_interface not fully examined"
+ " on this platform..."}
+ end.
+
+do_basic(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line Path = ?config(data_dir, Config),
+
+ ?line erl_ddll:start(),
+
+ %% Load the echo driver and verify that it was loaded.
+ {ok,L1,L2}=load_port_call_driver(Path),
+
+ %% Verify that the driver works.
+
+ ?line Port = open_port({spawn, port_call_drv}, [eof]),
+ ?line {hej, "hopp",4711,123445567436543653} =
+ erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}),
+ ?line {hej, "hopp",4711,123445567436543653} =
+ erlang:port_call(Port,0,{hej, "hopp",4711,123445567436543653}),
+ ?line {[], a, [], b, c} =
+ erlang:port_call(Port,1,{hej, "hopp",4711,123445567436543653}),
+ ?line {return, {[], a, [], b, c}} =
+ erlang:port_call(Port,2,{[], a, [], b, c}),
+ ?line List = lists:duplicate(200,5),
+ ?line {return, List} = erlang:port_call(Port,2,List),
+ ?line {'EXIT',{badarg,_}} = (catch erlang:port_call(Port,4711,[])),
+ ?line {'EXIT',{badarg,_}} = (catch erlang:port_call(sune,2,[])),
+ ?line register(gunnar,Port),
+ ?line {return, List} = erlang:port_call(gunnar,2,List),
+ ?line {return, a} = erlang:port_call(gunnar,2,a),
+ ?line erlang:port_close(Port),
+ %% Unload the driver and verify that it was unloaded.
+ ok=unload_port_call_driver(L1,L2),
+
+ ?line {error, {already_started, _}} = erl_ddll:start(),
+ ?line ok = erl_ddll:stop(),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+load_port_call_driver(Path) ->
+ ?line {ok, L1} = erl_ddll:loaded_drivers(),
+ ?line ok = erl_ddll:load_driver(Path, port_call_drv),
+ ?line {ok, L2} = erl_ddll:loaded_drivers(),
+ ?line ["port_call_drv"] = ordsets:to_list(ordsets:subtract(ordsets:from_list(L2),
+ ordsets:from_list(L1))),
+ {ok,L1,L2}.
+
+unload_port_call_driver(L1,L2) ->
+ ?line {ok, L2} = erl_ddll:loaded_drivers(),
+ ?line ok = erl_ddll:unload_driver(port_call_drv),
+ ?line {ok, L3} = erl_ddll:loaded_drivers(),
+ ?line [] = ordsets:to_list(ordsets:subtract(ordsets:from_list(L3),
+ ordsets:from_list(L1))),
+ ok.
+
diff --git a/lib/erl_interface/test/port_call_SUITE_data/Makefile.src b/lib/erl_interface/test/port_call_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..dc7385ba32
--- /dev/null
+++ b/lib/erl_interface/test/port_call_SUITE_data/Makefile.src
@@ -0,0 +1,39 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+include @erl_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib_drv@
+LIBEI = $(LIBPATH)/@erl_interface_eilib_drv@
+
+SHLIB_EXTRA_LDLIBS = $(LIBERL) $(LIBEI)
+SHLIB_EXTRA_CFLAGS = -I@erl_interface_include@ -I../all_SUITE_data
+
+
+all: port_call_drv@dll@
+
+clean:
+ $(RM) port_call_drv@obj@
+ $(RM) port_call_drv@dll@
+
+@SHLIB_RULES@
diff --git a/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c b/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c
new file mode 100644
index 0000000000..80811fb973
--- /dev/null
+++ b/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c
@@ -0,0 +1,103 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include <stdio.h>
+#include "erl_interface.h"
+#include "erl_driver.h"
+
+static ErlDrvPort my_erlang_port;
+static ErlDrvData echo_start(ErlDrvPort, char *);
+static void from_erlang(ErlDrvData, char*, int);
+static int do_call(ErlDrvData drv_data, unsigned int command, char *buf,
+ int len, char **rbuf, int rlen, unsigned *ret_flags);
+static ErlDrvEntry echo_driver_entry = {
+ NULL, /* Init */
+ echo_start,
+ NULL, /* Stop */
+ from_erlang,
+ NULL, /* Ready input */
+ NULL, /* Ready output */
+ "port_call_drv",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ do_call
+};
+
+DRIVER_INIT(echo_drv)
+{
+ return &echo_driver_entry;
+}
+
+static ErlDrvData
+echo_start(ErlDrvPort port, char *buf)
+{
+ return (ErlDrvData) port;
+}
+
+static void
+from_erlang(ErlDrvData data, char *buf, int count)
+{
+ driver_output((ErlDrvPort) data, buf, count);
+}
+
+static int
+do_call(ErlDrvData drv_data, unsigned int command, char *buf,
+ int len, char **rbuf, int rlen, unsigned *ret_flags)
+{
+ int nlen;
+ ei_x_buff x;
+
+ switch (command) {
+ case 0:
+ *rbuf = buf;
+ *ret_flags |= DRIVER_CALL_KEEP_BUFFER;
+ return len;
+ case 1:
+ ei_x_new(&x);
+ ei_x_format(&x, "{[], a, [], b, c}");
+ nlen = x.index;
+ if (nlen > rlen) {
+ *rbuf =driver_alloc(nlen);
+ }
+ memcpy(*rbuf,x.buff,nlen);
+ ei_x_free(&x);
+ return nlen;
+ case 2:
+ ei_x_new(&x);
+ ei_x_encode_version(&x);
+ ei_x_encode_tuple_header(&x,2);
+ ei_x_encode_atom(&x,"return");
+ ei_x_append_buf(&x,buf+1,len-1);
+ nlen = x.index;
+ if (nlen > rlen) {
+ *rbuf =driver_alloc(nlen);
+ }
+ memcpy(*rbuf,x.buff,nlen);
+ ei_x_free(&x);
+ return nlen;
+ default:
+ return -1;
+ }
+}
+
diff --git a/lib/erl_interface/test/runner.erl b/lib/erl_interface/test/runner.erl
new file mode 100644
index 0000000000..b72723c6a5
--- /dev/null
+++ b/lib/erl_interface/test/runner.erl
@@ -0,0 +1,130 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(runner).
+
+-export([test/1, test/2,
+ start/1, send_term/2, finish/1, send_eot/1, recv_eot/1,
+ get_term/1, get_term/2]).
+
+-define(default_timeout, test_server:seconds(5)).
+
+%% Executes a test case in a C program.
+%%
+%% This function is useful for test cases written in C which requires
+%% no further input, and only returns a result by calling report().
+
+test(Tc) ->
+ test(Tc, ?default_timeout).
+
+test(Tc, Timeout) ->
+ Port = start(Tc),
+
+ case get_term(Port, Timeout) of
+ eot ->
+ ok;
+ Other ->
+ io:format("In this test case, a success/failure result was"),
+ io:format("expected from the C program.\n"),
+ io:format("Received: ~p", [Other]),
+ test_server:fail()
+ end.
+
+%% Executes a test case in a C program. Returns the port.
+%%
+%% Use get_term/1,2.
+%%
+%% Returns: {ok, Port}
+
+start({Prog, Tc}) when is_list(Prog), is_integer(Tc) ->
+ Port = open_port({spawn, Prog}, [{packet, 4}]),
+ Command = [Tc div 256, Tc rem 256],
+ Port ! {self(), {command, Command}},
+ Port.
+
+%% Finishes a test case by send an 'eot' message to the C program
+%% and waiting for an 'eot'.
+%%
+%% If the C program doesn't require an 'eot', use recv_eot/1 instead.
+
+finish(Port) when is_port(Port) ->
+ send_eot(Port),
+ recv_eot(Port).
+
+%% Sends an Erlang term to a C program.
+
+send_term(Port, Term) when is_port(Port) ->
+ Port ! {self(), {command, [$t, term_to_binary(Term)]}}.
+
+%% Sends an 'eot' (end-of-test) indication to a C progrm.
+
+send_eot(Port) when is_port(Port) ->
+ Port ! {self(), {command, [$e]}}.
+
+%% Waits for an 'eot' indication from the C program.
+%% Either returns 'ok' or invokes test_server:fail().
+
+recv_eot(Port) when is_port(Port) ->
+ case get_term(Port) of
+ eot ->
+ ok;
+ Other ->
+ io:format("Error finishing test case. Expected eof from"),
+ io:format("C program, but got:"),
+ io:format("~p", [Other]),
+ test_server:fail()
+ end.
+
+%% Reads a term from the C program.
+%%
+%% Returns: {term, Term}|eot|'NULL' or calls test_server:fail/1,2.
+
+get_term(Port) ->
+ get_term(Port, ?default_timeout).
+
+get_term(Port, Timeout) ->
+ case get_reply(Port, Timeout) of
+ [$b|Bytes] ->
+ {bytes, Bytes};
+ [$f] ->
+ test_server:fail();
+ [$f|Reason] ->
+ test_server:fail(Reason);
+ [$t|Term] ->
+ {term, binary_to_term(list_to_binary(Term))};
+ [$N] ->
+ 'NULL';
+ [$e] ->
+ eot;
+ [$m|Message] ->
+ io:format("~s", [Message]),
+ get_term(Port, Timeout);
+ Other ->
+ io:format("Garbage received from C program: ~p", [Other]),
+ test_server:fail("Illegal response from C program")
+ end.
+
+get_reply(Port, Timeout) when is_port(Port) ->
+ receive
+ {Port, {data, Reply}} ->
+ Reply
+ after Timeout ->
+ test_server:fail("No response from C program")
+ end.
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 3df6f4bb90..7ea7de8d58 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -334,6 +334,10 @@ obsolete_1(ssl_pkix, decode_cert_file, A) when A =:= 1; A =:= 2 ->
{deprecated,"deprecated (will be removed in R14B); use public_key:pem_to_der/1 and public_key:pkix_decode_cert/2 instead"};
obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 ->
{deprecated,{public_key,pkix_decode_cert,2},"R14B"};
+
+%% Added in R13B04.
+obsolete_1(erlang, concat_binary, 1) ->
+ {deprecated,{erlang,list_to_binary,1},"R14B"};
obsolete_1(_, _, _) ->
no.