diff options
Diffstat (limited to 'lib/erl_interface/test/erl_eterm_SUITE_data')
5 files changed, 1877 insertions, 0 deletions
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; +} + |