diff options
Diffstat (limited to 'lib')
76 files changed, 13070 insertions, 0 deletions
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. |