path: root/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c

/*
 * %CopyrightBegin%
 * 
 * Copyright Ericsson AB 1997-2016. All Rights Reserved.
 * 
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 * 
 * %CopyrightEnd%
 */

/*
 * Purpose: 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);
}

static int abs_and_sign(ETERM* v, unsigned long long* av, int* sign)
{
    long long sv;
    switch (ERL_TYPE(v)) {
    case ERL_INTEGER: sv = ERL_INT_VALUE(v); break;
    case ERL_U_INTEGER: *av = ERL_INT_UVALUE(v); *sign = 0; return 1;
    case ERL_LONGLONG: sv = ERL_LL_VALUE(v); break;
    case ERL_U_LONGLONG: *av = ERL_LL_UVALUE(v); *sign = 0; return 1;
    default: return 0;
    }
    if (sv < 0) {
	*av = -sv;
	*sign = 1;
    }
    else {
	*av = sv;
	*sign = 0;
    }
    return 1;
}

/* Shouldn't erl_match() cope with this?
*/
static int eq_ints(ETERM* a, ETERM* b)
{
    unsigned long long a_abs, b_abs;
    int a_sign, b_sign;
    return abs_and_sign(a, &a_abs, &a_sign) && abs_and_sign(b, &b_abs, &b_sign)
           && (a_abs == b_abs) && (a_sign == b_sign);
}

static void encode_decode(ETERM* original, const char* text)
{
    static unsigned char encoded[16*1024];
    ETERM* new_terms;
    ETERM* head;
    int bytes;
    int len;

    /* If a list, check the elements one by one first */
    head = erl_hd(original);
    if (head != NULL) {
	encode_decode(head, "CAR");
	encode_decode(erl_tl(original), "CDR");
    }

    bytes = erl_encode(original, encoded);
    if (bytes == 0) {
	fail("failed to encode terms");
    } 
    else if (bytes > sizeof(encoded)) {
	fail("encoded terms buffer overflow");
    }
    else if (bytes != (len=erl_term_len(original))) {
	fprintf(stderr, "bytes(%d) != len(%d) for term ", bytes, len);
	erl_print_term(stderr, original);
	fprintf(stderr, " [%s]\r\n", text);
	fail("erl_encode and erl_term_len do not agree");
    }
    else if ((new_terms = erl_decode(encoded)) == NULL) {
	fail("failed to decode terms");
    }
    else if (!erl_match(original, new_terms) && !eq_ints(original, new_terms)) {
	erl_print_term(stderr, original);
	fprintf(stderr, "(%i) != (%i)", ERL_TYPE(original), ERL_TYPE(new_terms));
	erl_print_term(stderr, new_terms);
	fprintf(stderr, " [%s]\r\n", text);
	fail("decoded terms didn't match original");
    }
    erl_free_term(original);
    erl_free_term(new_terms);
}
/*
 * Converts an Erlang term to the external term format and back again.
 */

TESTCASE(round_trip_conversion)
{
    int n, i;

    erl_init(NULL, 0);
    encode_decode(all_types(), "ALL");

    {
	int v;
	for (v = 8; v; v <<= 1) {
	    for (i=-4; i<4; i++) {
		encode_decode(erl_mk_int(v+i), "INT");
		encode_decode(erl_mk_int(-(v+i)), "NEG INT");
	    }
	}
    }
    {
	unsigned int v;
	for (v = 8; v; v <<= 1) {
	    for (i=-4; i<4; i++) {
		encode_decode(erl_mk_uint(v+i), "UINT");
	    }
	}
    }
    {
	long long v;
	for (v = 8; v; v <<= 1) {
	    for (i=-4; i<4; i++) {
		encode_decode(erl_mk_longlong(v+i), "LONGLONG");
		encode_decode(erl_mk_longlong(-(v+i)), "NEG LONGLONG");
	    }
	}
    }
    {
	unsigned long long v;
	for (v = 8; v; v <<= 1) {
	    for (i=-4; i<4; i++) {
		encode_decode(erl_mk_ulonglong(v+i), "ULONGLONG");
	    }
	}
    }

    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, ">");
}