← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
 
1
/*
 
2
 * %CopyrightBegin%
 
3
 * 
 
4
 * Copyright Ericsson AB 1997-2010. All Rights Reserved.
 
5
 * 
 
6
 * The contents of this file are subject to the Erlang Public License,
 
7
 * Version 1.1, (the "License"); you may not use this file except in
 
8
 * compliance with the License. You should have received a copy of the
 
9
 * Erlang Public License along with this software. If not, it can be
 
10
 * retrieved online at http://www.erlang.org/.
 
11
 * 
 
12
 * Software distributed under the License is distributed on an "AS IS"
 
13
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
14
 * the License for the specific language governing rights and limitations
 
15
 * under the License.
 
16
 * 
 
17
 * %CopyrightEnd%
 
18
 */
 
19
 
 
20
/*
 
21
 * Purpose: Tests the functions in erl_eterm.c and erl_malloc.c.
 
22
 * Author: Bjorn Gustavsson
 
23
 *
 
24
 * See the erl_eterm_SUITE.erl file for a "table of contents".
 
25
 */
 
26
 
 
27
#include <stdio.h>
 
28
#include <string.h>
 
29
 
 
30
#include "runner.h"
 
31
 
 
32
/*
 
33
 * Find out which version of erl_interface we are using.
 
34
 */
 
35
 
 
36
#ifdef ERL_IS_STRING
 
37
#undef NEW_ERL_INTERFACE
 
38
#else
 
39
#define NEW_ERL_INTERFACE
 
40
#endif
 
41
 
 
42
void dump_term (FILE *fp, ETERM *t);
 
43
 
 
44
static ETERM* all_types();
 
45
 
 
46
/***********************************************************************
 
47
 *
 
48
 *      1.   B a s i c    t e s t s
 
49
 *
 
50
 ***********************************************************************/
 
51
 
 
52
/*
 
53
 * Sends a list contaning all data types to the Erlang side.
 
54
 */
 
55
 
 
56
TESTCASE(build_terms)
 
57
{
 
58
    ETERM* t;
 
59
 
 
60
    erl_init(NULL, 0);
 
61
    t = all_types();
 
62
    send_term(t);
 
63
    report(1);
 
64
}
 
65
 
 
66
static int abs_and_sign(ETERM* v, unsigned long long* av, int* sign)
 
67
{
 
68
    long long sv;
 
69
    switch (ERL_TYPE(v)) {
 
70
    case ERL_INTEGER: sv = ERL_INT_VALUE(v); break;
 
71
    case ERL_U_INTEGER: *av = ERL_INT_UVALUE(v); *sign = 0; return 1;
 
72
    case ERL_LONGLONG: sv = ERL_LL_VALUE(v); break;
 
73
    case ERL_U_LONGLONG: *av = ERL_LL_UVALUE(v); *sign = 0; return 1;
 
74
    default: return 0;
 
75
    }
 
76
    if (sv < 0) {
 
77
        *av = -sv;
 
78
        *sign = 1;
 
79
    }
 
80
    else {
 
81
        *av = sv;
 
82
        *sign = 0;
 
83
    }
 
84
    return 1;
 
85
}
 
86
 
 
87
/* Shouldn't erl_match() cope with this?
 
88
*/
 
89
static int eq_ints(ETERM* a, ETERM* b)
 
90
{
 
91
    unsigned long long a_abs, b_abs;
 
92
    int a_sign, b_sign;
 
93
    return abs_and_sign(a, &a_abs, &a_sign) && abs_and_sign(b, &b_abs, &b_sign)
 
94
           && (a_abs == b_abs) && (a_sign == b_sign);
 
95
}
 
96
 
 
97
static void encode_decode(ETERM* original, const char* text)
 
98
{
 
99
    static unsigned char encoded[16*1024];
 
100
    ETERM* new_terms;
 
101
    ETERM* head;
 
102
    int bytes;
 
103
    int len;
 
104
 
 
105
    /* If a list, check the elements one by one first */
 
106
    head = erl_hd(original);
 
107
    if (head != NULL) {
 
108
        encode_decode(head, "CAR");
 
109
        encode_decode(erl_tl(original), "CDR");
 
110
    }
 
111
 
 
112
    bytes = erl_encode(original, encoded);
 
113
    if (bytes == 0) {
 
114
        fail("failed to encode terms");
 
115
    } 
 
116
    else if (bytes > sizeof(encoded)) {
 
117
        fail("encoded terms buffer overflow");
 
118
    }
 
119
    else if (bytes != (len=erl_term_len(original))) {
 
120
        fprintf(stderr, "bytes(%d) != len(%d) for term ", bytes, len);
 
121
        erl_print_term(stderr, original);
 
122
        fprintf(stderr, " [%s]\r\n", text);
 
123
        fail("erl_encode and erl_term_len do not agree");
 
124
    }
 
125
    else if ((new_terms = erl_decode(encoded)) == NULL) {
 
126
        fail("failed to decode terms");
 
127
    }
 
128
    else if (!erl_match(original, new_terms) && !eq_ints(original, new_terms)) {
 
129
        erl_print_term(stderr, original);
 
130
        fprintf(stderr, "(%i) != (%i)", ERL_TYPE(original), ERL_TYPE(new_terms));
 
131
        erl_print_term(stderr, new_terms);
 
132
        fprintf(stderr, " [%s]\r\n", text);
 
133
        fail("decoded terms didn't match original");
 
134
    }
 
135
    erl_free_term(original);
 
136
    erl_free_term(new_terms);
 
137
}
 
138
/*
 
139
 * Converts an Erlang term to the external term format and back again.
 
140
 */
 
141
 
 
142
TESTCASE(round_trip_conversion)
 
143
{
 
144
    int n, i;
 
145
 
 
146
    erl_init(NULL, 0);
 
147
    encode_decode(all_types(), "ALL");
 
148
 
 
149
    {
 
150
        int v;
 
151
        for (v = 8; v; v <<= 1) {
 
152
            for (i=-4; i<4; i++) {
 
153
                encode_decode(erl_mk_int(v+i), "INT");
 
154
                encode_decode(erl_mk_int(-(v+i)), "NEG INT");
 
155
            }
 
156
        }
 
157
    }
 
158
    {
 
159
        unsigned int v;
 
160
        for (v = 8; v; v <<= 1) {
 
161
            for (i=-4; i<4; i++) {
 
162
                encode_decode(erl_mk_uint(v+i), "UINT");
 
163
            }
 
164
        }
 
165
    }
 
166
    {
 
167
        long long v;
 
168
        for (v = 8; v; v <<= 1) {
 
169
            for (i=-4; i<4; i++) {
 
170
                encode_decode(erl_mk_longlong(v+i), "LONGLONG");
 
171
                encode_decode(erl_mk_longlong(-(v+i)), "NEG LONGLONG");
 
172
            }
 
173
        }
 
174
    }
 
175
    {
 
176
        unsigned long long v;
 
177
        for (v = 8; v; v <<= 1) {
 
178
            for (i=-4; i<4; i++) {
 
179
                encode_decode(erl_mk_ulonglong(v+i), "ULONGLONG");
 
180
            }
 
181
        }
 
182
    }
 
183
 
 
184
    report(1);
 
185
}
 
186
 
 
187
/*
 
188
 * Decodes data from the Erlang side and verifies.
 
189
 */
 
190
 
 
191
TESTCASE(decode_terms)
 
192
{
 
193
    ETERM* terms;
 
194
    char* message;
 
195
 
 
196
    erl_init(NULL, 0);
 
197
    terms = get_term();
 
198
    if (terms == NULL) {
 
199
        fail("unexpected end of file");
 
200
    } else {
 
201
        ETERM* all;
 
202
        ETERM* p;
 
203
        ETERM* t;
 
204
        int i;
 
205
 
 
206
        all = p = all_types();
 
207
        t = terms;
 
208
 
 
209
        /*
 
210
         * XXX For now, skip the reference, pid, and port, because
 
211
         * the match will fail.  Must write code here to do some other
 
212
         * validating.
 
213
         */
 
214
 
 
215
        for (i=0; i<6; i++) {
 
216
 
 
217
          p = erl_tl(p);
 
218
          t = erl_tl(t);
 
219
          erl_free_term(p);
 
220
          erl_free_term(t);
 
221
 
 
222
        }
 
223
 
 
224
        /* 
 
225
         * Match the tail of the lists.
 
226
         */
 
227
 
 
228
        if (!erl_match(p, t))
 
229
        {
 
230
            fail("Received terms didn't match expected");
 
231
        }
 
232
        erl_free_term(all);
 
233
        erl_free_term(terms);
 
234
        report(1);
 
235
    }
 
236
}
 
237
 
 
238
/*
 
239
 * Decodes a float from the Erlang side and verifies.
 
240
 */
 
241
 
 
242
TESTCASE(decode_float)
 
243
{
 
244
    ETERM* afnum;
 
245
    ETERM* efnum;
 
246
    int result;
 
247
 
 
248
    erl_init(NULL, 0);
 
249
    afnum = get_term();
 
250
    efnum = erl_mk_float(3.1415);
 
251
    result = erl_match(efnum, afnum);
 
252
    erl_free_term(afnum);
 
253
    erl_free_term(efnum);
 
254
    report(result);
 
255
}    
 
256
    
 
257
/*
 
258
 * Tests the erl_free_compound() function.
 
259
 */
 
260
 
 
261
TESTCASE(t_erl_free_compound)
 
262
{
 
263
    ETERM* t;
 
264
 
 
265
    erl_init(NULL, 0);
 
266
 
 
267
    t = all_types();
 
268
    erl_free_compound(t);
 
269
    report(1);
 
270
}
 
271
 
 
272
 
 
273
/***********************************************************************
 
274
 *
 
275
 *      2.   C o n s t r u c t i n g   t e r m s
 
276
 *
 
277
 ***********************************************************************/
 
278
 
 
279
/*
 
280
 * Makes various integers, and sends them to Erlang for verification.
 
281
 */
 
282
 
 
283
TESTCASE(t_erl_mk_int)
 
284
{
 
285
#define SEND_INT(i) \
 
286
    do { \
 
287
         ETERM* t = erl_mk_int(i); \
 
288
         send_term(t); \
 
289
     } while (0);
 
290
 
 
291
    erl_init(NULL, 0);
 
292
 
 
293
    SEND_INT(0);
 
294
    SEND_INT(127);
 
295
    SEND_INT(128);
 
296
    SEND_INT(255);
 
297
    SEND_INT(256);
 
298
 
 
299
    SEND_INT(0xFFFF);
 
300
    SEND_INT(0x10000);
 
301
 
 
302
    SEND_INT(0x07FFFFFF);
 
303
    SEND_INT(0x0FFFFFFF);
 
304
    SEND_INT(0x1FFFFFFF);
 
305
    SEND_INT(0x3FFFFFFF);
 
306
    SEND_INT(0x7FFFFFFF);
 
307
 
 
308
    SEND_INT(0x08000000);
 
309
    SEND_INT(0x10000000);
 
310
    SEND_INT(0x20000000);
 
311
    SEND_INT(0x40000000);
 
312
 
 
313
    SEND_INT(-0x07FFFFFF);
 
314
    SEND_INT(-0x0FFFFFFF);
 
315
    SEND_INT(-0x1FFFFFFF);
 
316
    SEND_INT(-0x3FFFFFFF);
 
317
    SEND_INT(-0x7FFFFFFF);
 
318
 
 
319
    SEND_INT(-0x08000000);
 
320
    SEND_INT(-0x10000000);
 
321
    SEND_INT(-0x20000000);
 
322
    SEND_INT(-0x40000000);
 
323
 
 
324
    SEND_INT(-0x08000001);
 
325
    SEND_INT(-0x10000001);
 
326
    SEND_INT(-0x20000001);
 
327
    SEND_INT(-0x40000001);
 
328
 
 
329
    SEND_INT(-0x08000002);
 
330
    SEND_INT(-0x10000002);
 
331
    SEND_INT(-0x20000002);
 
332
    SEND_INT(-0x40000002);
 
333
 
 
334
    SEND_INT(-1999999999);
 
335
    SEND_INT(-2000000000);
 
336
    SEND_INT(-2000000001);
 
337
 
 
338
    report(1);
 
339
}
 
340
 
 
341
 
 
342
/*
 
343
 * Makes lists of various sizes, and sends them to Erlang for verification.
 
344
 */
 
345
 
 
346
TESTCASE(t_erl_mk_list)
 
347
{
 
348
    ETERM* a[4];
 
349
 
 
350
    erl_init(NULL, 0);
 
351
 
 
352
    /*
 
353
     * Empty list.
 
354
     */
 
355
 
 
356
    send_term(erl_mk_list(a, 0));
 
357
 
 
358
    /*
 
359
     * One element: [abc]
 
360
     */
 
361
 
 
362
    a[0] = erl_mk_atom("abc");
 
363
    send_term(erl_mk_list(a, 1));
 
364
    erl_free_term(a[0]);
 
365
 
 
366
    /*
 
367
     * Two elements: [abcdef, 42].
 
368
     */
 
369
 
 
370
    a[0] = erl_mk_atom("abcdef");
 
371
    a[1] = erl_mk_int(42);
 
372
    send_term(erl_mk_list(a, 2));
 
373
    erl_free_term(a[0]);
 
374
    erl_free_term(a[1]);
 
375
 
 
376
    /*
 
377
     * Four elements.
 
378
     */
 
379
 
 
380
    a[0] = erl_mk_float(0.0);
 
381
    a[1] = erl_mk_int(23);
 
382
    a[2] = erl_mk_empty_list();
 
383
    a[3] = erl_mk_float(3.1415);
 
384
    send_term(erl_mk_list(a, 4));
 
385
    erl_free_term(a[0]);
 
386
    erl_free_term(a[1]);
 
387
    erl_free_term(a[2]);
 
388
    erl_free_term(a[3]);
 
389
    
 
390
    report(1);
 
391
}
 
392
 
 
393
/*
 
394
 * A basic test of erl_copy_term().
 
395
 */
 
396
 
 
397
TESTCASE(basic_copy)
 
398
{
 
399
    ETERM* original;
 
400
    ETERM* copy;
 
401
    int result;
 
402
 
 
403
    erl_init(NULL, 0);
 
404
    original = all_types();
 
405
    copy = erl_copy_term(original);
 
406
    if (copy == NULL) {
 
407
        fail("erl_copy_term() failed");
 
408
    } else if (!erl_match(original, copy))
 
409
    {
 
410
        fail("copy doesn't match original");
 
411
    }
 
412
    
 
413
    erl_free_term(original);
 
414
    erl_free_term(copy);
 
415
    report(1);
 
416
}
 
417
 
 
418
 
 
419
/*
 
420
 * A basic test of erl_mk_atom().
 
421
 */
 
422
 
 
423
TESTCASE(t_erl_mk_atom)
 
424
{
 
425
    erl_init(NULL, 0);
 
426
 
 
427
    send_term(erl_mk_atom("madonna"));
 
428
    send_term(erl_mk_atom("Madonna"));
 
429
    send_term(erl_mk_atom("mad donna"));
 
430
    send_term(erl_mk_atom("_madonna_"));
 
431
    send_term(erl_mk_atom("/home/madonna/tour_plan"));
 
432
    send_term(erl_mk_atom("http://www.madonna.com/tour_plan"));
 
433
    send_term(erl_mk_atom("\'madonna\'"));
 
434
    send_term(erl_mk_atom("\"madonna\""));
 
435
    send_term(erl_mk_atom("\\madonna\\"));
 
436
    send_term(erl_mk_atom("{madonna,21,'mad donna',12}"));
 
437
 
 
438
    report(1);
 
439
}
 
440
 
 
441
 
 
442
/*
 
443
 * A basic test of erl_mk_binary().
 
444
 */
 
445
 
 
446
TESTCASE(t_erl_mk_binary)
 
447
{
 
448
 
 
449
    char* string;
 
450
    erl_init(NULL, 0);
 
451
 
 
452
    string = "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}";
 
453
    send_term(erl_mk_binary(string,strlen(string)));
 
454
 
 
455
    report(1);
 
456
}
 
457
 
 
458
 
 
459
/*
 
460
 * A basic test of erl_mk_empty_list().
 
461
 */
 
462
 
 
463
TESTCASE(t_erl_mk_empty_list)
 
464
{
 
465
    erl_init(NULL, 0);
 
466
 
 
467
    send_term(erl_mk_empty_list());
 
468
    report(1);
 
469
}
 
470
 
 
471
 
 
472
/*
 
473
 * A basic test of erl_mk_float().
 
474
 */
 
475
 
 
476
TESTCASE(t_erl_mk_float)
 
477
{
 
478
    ETERM* arr[6];
 
479
    ETERM* emsg;
 
480
 
 
481
    erl_init(NULL, 0);
 
482
 
 
483
    arr[0] = erl_mk_float(3.1415);
 
484
    arr[1] = erl_mk_float(1.999999);
 
485
    arr[2] = erl_mk_float(2.000000);
 
486
    arr[3] = erl_mk_float(2.000001);
 
487
    arr[4] = erl_mk_float(2.000002);
 
488
    arr[5] = erl_mk_float(12345.67890);
 
489
    emsg = (erl_mk_tuple(arr,6));
 
490
 
 
491
    send_term(emsg);
 
492
 
 
493
    erl_free_array(arr,6);
 
494
    /* emsg already freed by send_term() */
 
495
    /* erl_free_term(emsg); */ 
 
496
 
 
497
    report(1);
 
498
}
 
499
 
 
500
 
 
501
/*
 
502
 * A basic test of erl_mk_pid().
 
503
 */
 
504
 
 
505
TESTCASE(t_erl_mk_pid)
 
506
{
 
507
    erl_init(NULL, 0);
 
508
 
 
509
    send_term(erl_mk_pid("kalle@localhost", 3, 2, 1));
 
510
    report(1);
 
511
}
 
512
 
 
513
/*
 
514
 * A basic test of erl_mk_pid().
 
515
 */
 
516
 
 
517
TESTCASE(t_erl_mk_xpid)
 
518
{
 
519
    erl_init(NULL, 0);
 
520
 
 
521
    send_term(erl_mk_pid("kalle@localhost", 32767, 8191, 1));
 
522
    report(1);
 
523
}
 
524
 
 
525
 
 
526
/*
 
527
 * A basic test of erl_mk_port().
 
528
 */
 
529
 
 
530
TESTCASE(t_erl_mk_port)
 
531
{
 
532
    erl_init(NULL, 0);
 
533
 
 
534
    send_term(erl_mk_port("kalle@localhost", 4, 1));
 
535
    report(1);
 
536
}
 
537
 
 
538
/*
 
539
 * A basic test of erl_mk_port().
 
540
 */
 
541
 
 
542
TESTCASE(t_erl_mk_xport)
 
543
{
 
544
    erl_init(NULL, 0);
 
545
 
 
546
    send_term(erl_mk_port("kalle@localhost", 268435455, 1));
 
547
    report(1);
 
548
}
 
549
 
 
550
/*
 
551
 * A basic test of erl_mk_ref().
 
552
 */
 
553
 
 
554
TESTCASE(t_erl_mk_ref)
 
555
{
 
556
    erl_init(NULL, 0);
 
557
 
 
558
    send_term(erl_mk_ref("kalle@localhost", 6, 1));
 
559
    report(1);
 
560
}
 
561
 
 
562
/*
 
563
 * A basic test of erl_mk_long_ref().
 
564
 */
 
565
 
 
566
 
 
567
TESTCASE(t_erl_mk_long_ref)
 
568
{
 
569
    erl_init(NULL, 0);
 
570
 
 
571
    send_term(erl_mk_long_ref("kalle@localhost",
 
572
                              4294967295, 4294967295, 262143,
 
573
                              1));
 
574
    report(1);
 
575
}
 
576
 
 
577
 
 
578
/*
 
579
 * A basic test of erl_mk_string().
 
580
 */
 
581
 
 
582
TESTCASE(t_erl_mk_string)
 
583
{
 
584
 
 
585
    erl_init(NULL, 0);
 
586
 
 
587
    send_term(erl_mk_string("madonna"));
 
588
    send_term(erl_mk_string("Madonna"));
 
589
    send_term(erl_mk_string("mad donna"));
 
590
    send_term(erl_mk_string("_madonna_"));
 
591
    send_term(erl_mk_string("/home/madonna/tour_plan"));
 
592
    send_term(erl_mk_string("http://www.madonna.com/tour_plan"));
 
593
    send_term(erl_mk_string("\'madonna\'"));
 
594
    send_term(erl_mk_string("\"madonna\""));
 
595
    send_term(erl_mk_string("\\madonna\\"));
 
596
    send_term(erl_mk_string("{madonna,21,'mad donna',12}"));
 
597
 
 
598
    report(1);
 
599
}
 
600
 
 
601
 
 
602
/*
 
603
 * A basic test of erl_mk_estring().
 
604
 */
 
605
 
 
606
TESTCASE(t_erl_mk_estring)
 
607
{
 
608
    char* string;
 
609
    erl_init(NULL, 0);
 
610
 
 
611
    string = "madonna";
 
612
    send_term(erl_mk_estring(string,strlen(string)));
 
613
    string = "Madonna";
 
614
    send_term(erl_mk_estring(string,strlen(string)));
 
615
    string = "mad donna";
 
616
    send_term(erl_mk_estring(string,strlen(string)));
 
617
    string = "_madonna_";
 
618
    send_term(erl_mk_estring(string,strlen(string)));
 
619
    string = "/home/madonna/tour_plan";
 
620
    send_term(erl_mk_estring(string,strlen(string)));
 
621
    string = "http://www.madonna.com/tour_plan";
 
622
    send_term(erl_mk_estring(string,strlen(string)));
 
623
    string = "\'madonna\'";
 
624
    send_term(erl_mk_estring(string,strlen(string)));
 
625
    string = "\"madonna\"";
 
626
    send_term(erl_mk_estring(string,strlen(string)));
 
627
    string = "\\madonna\\";
 
628
    send_term(erl_mk_estring(string,strlen(string)));
 
629
    string = "{madonna,21,'mad donna',12}";
 
630
    send_term(erl_mk_estring(string,strlen(string)));
 
631
 
 
632
    report(1);
 
633
}
 
634
 
 
635
 
 
636
/*
 
637
 * A basic test of erl_mk_tuple().
 
638
 */
 
639
 
 
640
TESTCASE(t_erl_mk_tuple)
 
641
{
 
642
    ETERM* arr[4];
 
643
    ETERM* arr2[2];
 
644
    ETERM* arr3[2];
 
645
    ETERM* arr4[2];
 
646
 
 
647
    erl_init(NULL, 0);
 
648
 
 
649
    /* {madonna,21,'mad donna',12} */
 
650
    arr[0] = erl_mk_atom("madonna");
 
651
    arr[1] = erl_mk_int(21);
 
652
    arr[2] = erl_mk_atom("mad donna");
 
653
    arr[3] = erl_mk_int(12);
 
654
 
 
655
    send_term(erl_mk_tuple(arr,4));
 
656
 
 
657
    erl_free_array(arr,4);
 
658
 
 
659
 
 
660
    /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */
 
661
    arr4[0] = erl_mk_atom("home page");
 
662
    arr4[1] = erl_mk_string("http://www.madonna.com/");
 
663
 
 
664
    arr3[0] = erl_mk_string("Isabella");
 
665
    arr3[1] = erl_mk_int(2);
 
666
 
 
667
    arr2[0] = erl_mk_atom("children");
 
668
    arr2[1] = erl_mk_tuple(arr3,2);
 
669
 
 
670
    arr[0] = erl_mk_atom("Madonna");
 
671
    arr[1] = erl_mk_int(21);
 
672
    arr[2] = erl_mk_tuple(arr2,2);
 
673
    arr[3] = erl_mk_tuple(arr4,2);
 
674
 
 
675
    send_term(erl_mk_tuple(arr,4));
 
676
 
 
677
    erl_free_array(arr,4);
 
678
    erl_free_array(arr2,2);
 
679
    erl_free_array(arr3,2);
 
680
    erl_free_array(arr4,2);
 
681
 
 
682
 
 
683
    report(1);
 
684
}
 
685
 
 
686
 
 
687
/*
 
688
 * A basic test of erl_mk_uint().
 
689
 */
 
690
 
 
691
TESTCASE(t_erl_mk_uint)
 
692
{
 
693
    unsigned i;
 
694
 
 
695
    erl_init(NULL, 0);
 
696
 
 
697
    send_term(erl_mk_uint(54321));
 
698
    i = 2147483647;
 
699
    send_term(erl_mk_uint(i));
 
700
    send_term(erl_mk_uint(i+1));
 
701
    send_term(erl_mk_uint(i+2));
 
702
    send_term(erl_mk_uint(i+3));
 
703
    send_term(erl_mk_uint(i+i+1));
 
704
 
 
705
    report(1);
 
706
}
 
707
 
 
708
 
 
709
/*
 
710
 * A basic test of erl_mk_var().
 
711
 */
 
712
 
 
713
TESTCASE(t_erl_mk_var)
 
714
{
 
715
    ETERM* mk_var;
 
716
    ETERM* term;
 
717
    ETERM* term2;
 
718
    ETERM* arr[4];
 
719
    ETERM* arr_term[2];
 
720
    ETERM* mk_var_tuple;
 
721
    ETERM* term_tuple;
 
722
 
 
723
    erl_init(NULL, 0);
 
724
 
 
725
 
 
726
    /* match unbound/bound variable against an integer */
 
727
    term = erl_mk_int(17);
 
728
    term2 = erl_mk_int(2);
 
729
    mk_var = erl_mk_var("New_var");
 
730
    send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
 
731
    send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */
 
732
    send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
 
733
    send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */
 
734
    erl_free_term(mk_var);
 
735
    erl_free_term(term);
 
736
    erl_free_term(term2);
 
737
 
 
738
    /* match unbound variable against a tuple */    
 
739
    arr[0] = erl_mk_atom("madonna");
 
740
    arr[1] = erl_mk_int(21);
 
741
    arr[2] = erl_mk_atom("mad donna");
 
742
    arr[3] = erl_mk_int(12);
 
743
    mk_var = erl_mk_var("New_var");
 
744
    term = erl_mk_tuple(arr,4);
 
745
    send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */
 
746
    erl_free_term(mk_var);
 
747
    erl_free_term(term);
 
748
    erl_free_array(arr,4);
 
749
 
 
750
 
 
751
    /* match (twice) unbound variable against an incorrect tuple */    
 
752
    arr[0] = erl_mk_var("New_var");
 
753
    arr[1] = erl_mk_var("New_var"); 
 
754
    arr_term[0] = erl_mk_int(17);
 
755
    arr_term[1] = erl_mk_int(27);
 
756
    mk_var_tuple = erl_mk_tuple(arr,2);
 
757
    term_tuple = erl_mk_tuple(arr_term,2);
 
758
    send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should fail */
 
759
    erl_free_array(arr,2);
 
760
    erl_free_array(arr_term,2);
 
761
    erl_free_term(mk_var_tuple);
 
762
    erl_free_term(term_tuple);
 
763
 
 
764
 
 
765
    /* match (twice) unbound variable against a correct tuple */    
 
766
    arr[0] = erl_mk_var("New_var");
 
767
    arr[1] = erl_mk_var("New_var"); 
 
768
    arr_term[0] = erl_mk_int(17);
 
769
    arr_term[1] = erl_mk_int(17);
 
770
    mk_var_tuple = erl_mk_tuple(arr,2);
 
771
    term_tuple = erl_mk_tuple(arr_term,2);
 
772
    send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should be ok */
 
773
    erl_free_array(arr,2);
 
774
    erl_free_array(arr_term,2);
 
775
    erl_free_term(mk_var_tuple);
 
776
    erl_free_term(term_tuple);
 
777
 
 
778
    report(1);
 
779
}
 
780
 
 
781
 
 
782
/*
 
783
 * A basic test of erl_size().
 
784
 */
 
785
 
 
786
TESTCASE(t_erl_size)
 
787
{
 
788
    ETERM* arr[4];
 
789
    ETERM* tuple;
 
790
    ETERM* bin;
 
791
    char* string;
 
792
 
 
793
    erl_init(NULL, 0);
 
794
 
 
795
    /* size of a tuple */
 
796
    tuple = erl_format("{}");
 
797
    send_term(erl_mk_int(erl_size(tuple)));
 
798
    erl_free_term(tuple);
 
799
 
 
800
    arr[0] = erl_mk_atom("madonna");
 
801
    arr[1] = erl_mk_int(21);
 
802
    arr[2] = erl_mk_atom("mad donna");
 
803
    arr[3] = erl_mk_int(12);
 
804
    tuple = erl_mk_tuple(arr,4);
 
805
 
 
806
    send_term(erl_mk_int(erl_size(tuple)));
 
807
 
 
808
    erl_free_array(arr,4);
 
809
    erl_free_term(tuple);
 
810
 
 
811
    /* size of a binary */
 
812
    string = "";
 
813
    bin = erl_mk_binary(string,strlen(string));
 
814
    send_term(erl_mk_int(erl_size(bin)));
 
815
    erl_free_term(bin);
 
816
 
 
817
    string = "{madonna,21,'mad donna',12}";
 
818
    bin = erl_mk_binary(string,strlen(string));
 
819
    send_term(erl_mk_int(erl_size(bin)));
 
820
    erl_free_term(bin);
 
821
 
 
822
    report(1);
 
823
}
 
824
 
 
825
 
 
826
/*
 
827
 * A basic test of erl_var_content().
 
828
 */
 
829
 
 
830
TESTCASE(t_erl_var_content)
 
831
{
 
832
    ETERM* mk_var;
 
833
    ETERM* term;
 
834
    ETERM* tuple;
 
835
    ETERM* list;
 
836
    ETERM* a;
 
837
    ETERM* b;
 
838
    ETERM* arr[4];
 
839
    ETERM* arr2[2];
 
840
    ETERM* arr3[2];
 
841
    ETERM* arr4[2];
 
842
 
 
843
    erl_init(NULL, 0);
 
844
 
 
845
    term = erl_mk_int(17);
 
846
    mk_var = erl_mk_var("Var");
 
847
 
 
848
    /* unbound, should return NULL */
 
849
    if (erl_var_content(mk_var,"Var") != NULL) 
 
850
      fail("t_erl_var_content() failed");
 
851
 
 
852
    erl_match(mk_var, term); 
 
853
    send_term(erl_var_content(mk_var,"Var")); /* should return 17 */
 
854
 
 
855
    /* integer, should return NULL */
 
856
    if (erl_var_content(term,"Var") != NULL) 
 
857
      fail("t_erl_var_content() failed");
 
858
 
 
859
    /* unknown variable, should return NULL */
 
860
    if (erl_var_content(mk_var,"Unknown_Var") != NULL) 
 
861
      fail("t_erl_var_content() failed");
 
862
 
 
863
    erl_free_term(mk_var);
 
864
    erl_free_term(term);
 
865
 
 
866
    /* {'Madonna',21,{children,{"Name","Age"}},{"Home_page","Tel_no"}} */
 
867
    arr4[0] = erl_mk_var("Home_page");
 
868
    arr4[1] = erl_mk_var("Tel_no");
 
869
    a = erl_mk_string("http://www.madonna.com"); 
 
870
    erl_match(arr4[0], a); 
 
871
 
 
872
    arr3[0] = erl_mk_var("Name");
 
873
    arr3[1] = erl_mk_var("Age");
 
874
    b = erl_mk_int(2); 
 
875
    erl_match(arr3[1], b); 
 
876
 
 
877
    arr2[0] = erl_mk_atom("children");
 
878
    arr2[1] = erl_mk_tuple(arr3,2);
 
879
 
 
880
    arr[0] = erl_mk_atom("Madonna");
 
881
    arr[1] = erl_mk_int(21);
 
882
    arr[2] = erl_mk_tuple(arr2,2);
 
883
    arr[3] = erl_mk_tuple(arr4,2);
 
884
 
 
885
    tuple = erl_mk_tuple(arr,4);
 
886
 
 
887
    /* should return "http://www.madonna.com" */
 
888
    send_term(erl_var_content(tuple,"Home_page"));  
 
889
                                                 
 
890
    /* unbound, should return NULL */
 
891
    if (erl_var_content(tuple,"Tel_no") != NULL) 
 
892
      fail("t_erl_var_content() failed");
 
893
 
 
894
    /* unbound, should return NULL */
 
895
    if (erl_var_content(tuple,"Name") != NULL) 
 
896
      fail("t_erl_var_content() failed");
 
897
 
 
898
    /* should return 2 */
 
899
    send_term(erl_var_content(tuple,"Age")); 
 
900
 
 
901
    erl_free_array(arr,4);
 
902
    erl_free_array(arr2,2);
 
903
    erl_free_array(arr3,2);
 
904
    erl_free_array(arr4,2);
 
905
    erl_free_term(tuple);
 
906
    erl_free_term(a);
 
907
    erl_free_term(b);
 
908
 
 
909
 
 
910
    /* [] */
 
911
    list = erl_mk_empty_list();
 
912
    if (erl_var_content(list,"Tel_no") != NULL) 
 
913
      fail("t_erl_var_content() failed");
 
914
    erl_free_term(list);
 
915
    
 
916
 
 
917
    /* ['Madonna',[],{children,{"Name","Age"}},{"Home_page","Tel_no"}] */
 
918
    arr4[0] = erl_mk_var("Home_page");
 
919
    arr4[1] = erl_mk_var("Tel_no");
 
920
    a = erl_mk_string("http://www.madonna.com"); 
 
921
    erl_match(arr4[0], a); 
 
922
 
 
923
    arr3[0] = erl_mk_var("Name");
 
924
    arr3[1] = erl_mk_var("Age");
 
925
    b = erl_mk_int(2); 
 
926
    erl_match(arr3[1], b); 
 
927
 
 
928
    arr2[0] = erl_mk_atom("children");
 
929
    arr2[1] = erl_mk_tuple(arr3,2);
 
930
 
 
931
    arr[0] = erl_mk_atom("Madonna");
 
932
    arr[1] = erl_mk_empty_list();
 
933
    arr[2] = erl_mk_tuple(arr2,2);
 
934
    arr[3] = erl_mk_tuple(arr4,2);
 
935
 
 
936
    list = erl_mk_list(arr,4);
 
937
 
 
938
    /* should return "http://www.madonna.com" */
 
939
    send_term(erl_var_content(list,"Home_page"));  
 
940
                                                 
 
941
    /* unbound, should return NULL */
 
942
    if (erl_var_content(list,"Tel_no") != NULL) 
 
943
      fail("t_erl_var_content() failed");
 
944
 
 
945
    /* unbound, should return NULL */
 
946
    if (erl_var_content(list,"Name") != NULL) 
 
947
      fail("t_erl_var_content() failed");
 
948
 
 
949
    /* should return 2 */
 
950
    send_term(erl_var_content(list,"Age")); 
 
951
 
 
952
    erl_free_array(arr,4);
 
953
    erl_free_array(arr2,2);
 
954
    erl_free_array(arr3,2);
 
955
    erl_free_array(arr4,2);
 
956
    erl_free_term(list);
 
957
    erl_free_term(a);
 
958
    erl_free_term(b);
 
959
 
 
960
    report(1);
 
961
}
 
962
 
 
963
 
 
964
/*
 
965
 * A basic test of erl_element().
 
966
 */
 
967
 
 
968
TESTCASE(t_erl_element)
 
969
{
 
970
    ETERM* arr[4];
 
971
    ETERM* arr2[2];
 
972
    ETERM* arr3[2];
 
973
    ETERM* arr4[2];
 
974
    ETERM* tuple;
 
975
 
 
976
    erl_init(NULL, 0);
 
977
 
 
978
    arr[0] = erl_mk_atom("madonna");
 
979
    arr[1] = erl_mk_int(21);
 
980
    arr[2] = erl_mk_atom("mad donna");
 
981
    arr[3] = erl_mk_int(12);
 
982
    tuple = erl_mk_tuple(arr,4);
 
983
 
 
984
    send_term(erl_element(1,tuple));
 
985
    send_term(erl_element(2,tuple));
 
986
    send_term(erl_element(3,tuple));
 
987
    send_term(erl_element(4,tuple));
 
988
 
 
989
    erl_free_array(arr,4);
 
990
    erl_free_term(tuple);
 
991
 
 
992
    /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */
 
993
    arr4[0] = erl_mk_atom("home page");
 
994
    arr4[1] = erl_mk_string("http://www.madonna.com/");
 
995
 
 
996
    arr3[0] = erl_mk_string("Isabella");
 
997
    arr3[1] = erl_mk_int(2);
 
998
 
 
999
    arr2[0] = erl_mk_atom("children");
 
1000
    arr2[1] = erl_mk_tuple(arr3,2);
 
1001
 
 
1002
    arr[0] = erl_mk_atom("Madonna");
 
1003
    arr[1] = erl_mk_int(21);
 
1004
    arr[2] = erl_mk_tuple(arr2,2);
 
1005
    arr[3] = erl_mk_tuple(arr4,2);
 
1006
 
 
1007
    tuple = erl_mk_tuple(arr,4);
 
1008
    send_term(erl_element(1,tuple));
 
1009
    send_term(erl_element(2,tuple));
 
1010
    send_term(erl_element(3,tuple));
 
1011
    send_term(erl_element(4,tuple));
 
1012
 
 
1013
    erl_free_term(tuple);
 
1014
    erl_free_array(arr,4);
 
1015
    erl_free_array(arr2,2);
 
1016
    erl_free_array(arr3,2);
 
1017
    erl_free_array(arr4,2);
 
1018
 
 
1019
    report(1);
 
1020
}
 
1021
 
 
1022
 
 
1023
/*
 
1024
 * A basic test of erl_cons().
 
1025
 */
 
1026
 
 
1027
TESTCASE(t_erl_cons)
 
1028
{
 
1029
    ETERM* list;
 
1030
    ETERM* anAtom;
 
1031
    ETERM* anInt;
 
1032
 
 
1033
    erl_init(NULL, 0);
 
1034
 
 
1035
    anAtom = erl_mk_atom("madonna");
 
1036
    anInt = erl_mk_int(21);
 
1037
    list = erl_mk_empty_list();
 
1038
    list = erl_cons(anInt, list);
 
1039
    send_term(erl_cons(anAtom, list));
 
1040
 
 
1041
    erl_free_term(anAtom); 
 
1042
    erl_free_term(anInt);
 
1043
    erl_free_compound(list);
 
1044
 
 
1045
    report(1);
 
1046
}
 
1047
 
 
1048
 
 
1049
 
 
1050
 
 
1051
/***********************************************************************
 
1052
 *
 
1053
 *      3.   E x t r a c t i n g  &   i n f o    f u n c t i o n s
 
1054
 *
 
1055
 ***********************************************************************/
 
1056
 
 
1057
/*
 
1058
 * Calculates the length of each list sent to it and sends back the result.
 
1059
 */
 
1060
 
 
1061
TESTCASE(t_erl_length)
 
1062
{
 
1063
    erl_init(NULL, 0);
 
1064
 
 
1065
    for (;;) {
 
1066
        ETERM* term = get_term();
 
1067
 
 
1068
        if (term == NULL) {
 
1069
            report(1);
 
1070
            return;
 
1071
        } else {
 
1072
            ETERM* len_term;
 
1073
 
 
1074
            len_term = erl_mk_int(erl_length(term));
 
1075
            erl_free_term(term);
 
1076
            send_term(len_term);
 
1077
        }
 
1078
    }
 
1079
}
 
1080
 
 
1081
/*
 
1082
 * Gets the head of each term and sends the result back.
 
1083
 */
 
1084
 
 
1085
TESTCASE(t_erl_hd)
 
1086
{
 
1087
    erl_init(NULL, 0);
 
1088
 
 
1089
    for (;;) {
 
1090
        ETERM* term = get_term();
 
1091
 
 
1092
        if (term == NULL) {
 
1093
            report(1);
 
1094
            return;
 
1095
        } else {
 
1096
            ETERM* head;
 
1097
 
 
1098
            head = erl_hd(term);
 
1099
            send_term(head);
 
1100
            erl_free_term(term);
 
1101
        }
 
1102
    }
 
1103
}
 
1104
 
 
1105
/*
 
1106
 * Gets the tail of each term and sends the result back.
 
1107
 */
 
1108
 
 
1109
TESTCASE(t_erl_tl)
 
1110
{
 
1111
    erl_init(NULL, 0);
 
1112
 
 
1113
    for (;;) {
 
1114
        ETERM* term = get_term();
 
1115
 
 
1116
        if (term == NULL) {
 
1117
            report(1);
 
1118
            return;
 
1119
        } else {
 
1120
            ETERM* tail;
 
1121
 
 
1122
            tail = erl_tl(term);
 
1123
            send_term(tail);
 
1124
            erl_free_term(term);
 
1125
        }
 
1126
    }
 
1127
}
 
1128
 
 
1129
/*
 
1130
 * Checks the type checking macros.
 
1131
 */
 
1132
 
 
1133
TESTCASE(type_checks)
 
1134
{
 
1135
    ETERM* t;
 
1136
    ETERM* atom;
 
1137
 
 
1138
    erl_init(NULL, 0);
 
1139
    atom = erl_mk_atom("an_atom");
 
1140
 
 
1141
#define TYPE_CHECK(macro, term) \
 
1142
    { ETERM* t = term; \
 
1143
      if (macro(t)) { \
 
1144
         erl_free_term(t); \
 
1145
      } else { \
 
1146
         fail("Macro " #macro " failed on " #term); \
 
1147
      } \
 
1148
    }
 
1149
    
 
1150
    TYPE_CHECK(ERL_IS_INTEGER, erl_mk_int(0x7FFFFFFF));
 
1151
#ifdef NEW_ERL_INTERFACE
 
1152
    TYPE_CHECK(ERL_IS_UNSIGNED_INTEGER, erl_mk_uint(0x7FFFFFFF));
 
1153
#endif
 
1154
    TYPE_CHECK(ERL_IS_FLOAT, erl_mk_float(5.5));
 
1155
    TYPE_CHECK(ERL_IS_ATOM, erl_mk_atom("another_atom"));
 
1156
 
 
1157
    TYPE_CHECK(ERL_IS_EMPTY_LIST, erl_mk_empty_list());
 
1158
    TYPE_CHECK(!ERL_IS_EMPTY_LIST, erl_cons(atom, atom));
 
1159
 
 
1160
#ifdef NEW_ERL_INTERFACE
 
1161
    TYPE_CHECK(!ERL_IS_CONS, erl_mk_empty_list());
 
1162
    TYPE_CHECK(ERL_IS_CONS, erl_cons(atom, atom));
 
1163
#endif
 
1164
 
 
1165
    TYPE_CHECK(ERL_IS_LIST, erl_mk_empty_list());
 
1166
    TYPE_CHECK(ERL_IS_LIST, erl_cons(atom, atom));
 
1167
 
 
1168
    TYPE_CHECK(ERL_IS_PID, erl_mk_pid("a@a", 42, 1, 1));
 
1169
    TYPE_CHECK(ERL_IS_PORT, erl_mk_port("a@a", 42, 1));
 
1170
    TYPE_CHECK(ERL_IS_REF, erl_mk_ref("a@a", 42, 1));
 
1171
    
 
1172
    TYPE_CHECK(ERL_IS_BINARY, erl_mk_binary("a", 1));
 
1173
    TYPE_CHECK(ERL_IS_TUPLE, erl_mk_tuple(&atom, 1));
 
1174
#undef TYPE_CHECK
 
1175
 
 
1176
    erl_free_term(atom);
 
1177
 
 
1178
    report(1);
 
1179
}
 
1180
 
 
1181
/*
 
1182
 * Checks the extractor macros.
 
1183
 */
 
1184
 
 
1185
TESTCASE(extractor_macros)
 
1186
{
 
1187
  ETERM* t;
 
1188
 
 
1189
  erl_init(NULL, 0);
 
1190
 
 
1191
#ifdef NEW_ERL_INTERFACE
 
1192
#define MATCH(a, b) ((a) == (b) ? 1 : fail("bad match: " #a))
 
1193
#define STR_MATCH(a, b) (strcmp((a), (b)) ? fail("bad match: " #a) : 0)
 
1194
 
 
1195
  {                             /* Integer */
 
1196
    int anInt = 0x7FFFFFFF;
 
1197
    t = erl_mk_int(anInt);
 
1198
    MATCH(ERL_INT_VALUE(t), anInt);
 
1199
    MATCH(ERL_INT_UVALUE(t), anInt);
 
1200
    erl_free_term(t);
 
1201
  }
 
1202
 
 
1203
  {                             /* Float */
 
1204
    double aFloat = 3.1415;
 
1205
    t = erl_mk_float(aFloat);
 
1206
    MATCH(ERL_FLOAT_VALUE(t), aFloat);
 
1207
    erl_free_term(t);
 
1208
  }
 
1209
 
 
1210
  {                             /* Atom. */
 
1211
    char* aString = "nisse";
 
1212
    t = erl_mk_atom(aString);
 
1213
    if (memcmp(ERL_ATOM_PTR(t), aString, strlen(aString)) != 0)
 
1214
      fail("bad match");
 
1215
    MATCH(ERL_ATOM_SIZE(t), strlen(aString));
 
1216
    erl_free_term(t);
 
1217
  }
 
1218
 
 
1219
  {                             /* Pid. */
 
1220
    char* node = "arne@strider";
 
1221
    int number = 42;
 
1222
    int serial = 5;
 
1223
    int creation = 1;
 
1224
 
 
1225
    t = erl_mk_pid(node, number, serial, creation);
 
1226
    STR_MATCH(ERL_PID_NODE(t), node);
 
1227
    MATCH(ERL_PID_NUMBER(t), number);
 
1228
    MATCH(ERL_PID_SERIAL(t), serial);
 
1229
    MATCH(ERL_PID_CREATION(t), creation);
 
1230
    erl_free_term(t);
 
1231
  }
 
1232
 
 
1233
  {                             /* Port. */
 
1234
    char* node = "kalle@strider";
 
1235
    int number = 45;
 
1236
    int creation = 1;
 
1237
 
 
1238
    t = erl_mk_port(node, number, creation);
 
1239
    STR_MATCH(ERL_PORT_NODE(t), node);
 
1240
    MATCH(ERL_PORT_NUMBER(t), number);
 
1241
    MATCH(ERL_PORT_CREATION(t), creation);
 
1242
    erl_free_term(t);
 
1243
  }
 
1244
 
 
1245
  {                             /* Reference. */
 
1246
    char* node = "kalle@strider";
 
1247
    int number = 48;
 
1248
    int creation = 1;
 
1249
 
 
1250
    t = erl_mk_ref(node, number, creation);
 
1251
    STR_MATCH(ERL_REF_NODE(t), node);
 
1252
    MATCH(ERL_REF_NUMBER(t), number);
 
1253
    MATCH(ERL_REF_CREATION(t), creation);
 
1254
    erl_free_term(t);
 
1255
  }
 
1256
 
 
1257
  {                             /* Tuple. */
 
1258
    ETERM* arr[2];
 
1259
 
 
1260
    arr[0] = erl_mk_int(51);
 
1261
    arr[1] = erl_mk_int(52);
 
1262
    t = erl_mk_tuple(arr, ASIZE(arr));
 
1263
    MATCH(ERL_TUPLE_SIZE(t), ASIZE(arr));
 
1264
    MATCH(ERL_TUPLE_ELEMENT(t, 0), arr[0]);
 
1265
    MATCH(ERL_TUPLE_ELEMENT(t, 1), arr[1]);
 
1266
    erl_free_array(arr, ASIZE(arr));
 
1267
    erl_free_term(t);
 
1268
  }
 
1269
 
 
1270
  {                             /* Binary. */
 
1271
    static char bin[] = {1, 2, 3, 0, 4, 5};
 
1272
 
 
1273
    t = erl_mk_binary(bin, ASIZE(bin));
 
1274
    MATCH(ERL_BIN_SIZE(t), ASIZE(bin));
 
1275
    if (memcmp(ERL_BIN_PTR(t), bin, ASIZE(bin)) != 0)
 
1276
      fail("bad match");
 
1277
    erl_free_term(t);
 
1278
  }
 
1279
 
 
1280
  {
 
1281
    ETERM* head = erl_mk_atom("head");
 
1282
    ETERM* tail = erl_mk_atom("tail");
 
1283
 
 
1284
    t = erl_cons(head, tail);
 
1285
    MATCH(ERL_CONS_HEAD(t), head);
 
1286
    MATCH(ERL_CONS_TAIL(t), tail);
 
1287
    erl_free_term(head);
 
1288
    erl_free_term(tail);
 
1289
    erl_free_term(t);
 
1290
  }
 
1291
#undef MATCH
 
1292
#undef STR_MATCH
 
1293
#endif
 
1294
 
 
1295
  report(1);
 
1296
}
 
1297
 
 
1298
 
 
1299
 
 
1300
/***********************************************************************
 
1301
 *
 
1302
 *      4.   I / O   l i s t   f u n c t i o n s
 
1303
 *
 
1304
 ***********************************************************************/
 
1305
 
 
1306
/*
 
1307
 * Invokes erl_iolist_length() on each term and send backs the result.
 
1308
 */
 
1309
 
 
1310
TESTCASE(t_erl_iolist_length)
 
1311
{
 
1312
    erl_init(NULL, 0);
 
1313
 
 
1314
    for (;;) {
 
1315
        ETERM* term = get_term();
 
1316
 
 
1317
        if (term == NULL) {
 
1318
            report(1);
 
1319
            return;
 
1320
        } else {
 
1321
#ifndef NEW_ERL_INTERFACE
 
1322
            fail("Function not present in this version of erl_interface");
 
1323
#else
 
1324
            ETERM* len_term;
 
1325
 
 
1326
            len_term = erl_mk_int(erl_iolist_length(term));
 
1327
            erl_free_term(term);
 
1328
            send_term(len_term);
 
1329
#endif
 
1330
        }
 
1331
    }
 
1332
}
 
1333
 
 
1334
/*
 
1335
 * Invokes erl_iolist_to_binary() on each term and send backs the result.
 
1336
 */
 
1337
 
 
1338
TESTCASE(t_erl_iolist_to_binary)
 
1339
{
 
1340
    erl_init(NULL, 0);
 
1341
 
 
1342
    for (;;) {
 
1343
        ETERM* term = get_term();
 
1344
 
 
1345
        if (term == NULL) {
 
1346
            report(1);
 
1347
            return;
 
1348
        } else {
 
1349
#ifndef NEW_ERL_INTERFACE
 
1350
            fail("Function not present in this version of erl_interface");
 
1351
#else
 
1352
            ETERM* new_term;
 
1353
 
 
1354
            new_term = erl_iolist_to_binary(term);
 
1355
 
 
1356
            erl_free_term(term);
 
1357
            send_term(new_term);
 
1358
#endif
 
1359
        }
 
1360
    }
 
1361
}
 
1362
 
 
1363
/*
 
1364
 * Invokes erl_iolist_to_string() on each term and send backs the result.
 
1365
 */
 
1366
 
 
1367
TESTCASE(t_erl_iolist_to_string)
 
1368
{
 
1369
    erl_init(NULL, 0);
 
1370
 
 
1371
    for (;;) {
 
1372
        ETERM* term = get_term();
 
1373
 
 
1374
        if (term == NULL) {
 
1375
            report(1);
 
1376
            return;
 
1377
        } else {
 
1378
#ifndef NEW_ERL_INTERFACE
 
1379
            fail("Function not present in this version of erl_interface");
 
1380
#else
 
1381
            char* result;
 
1382
 
 
1383
            result = erl_iolist_to_string(term);
 
1384
            erl_free_term(term);
 
1385
            if (result != NULL) {
 
1386
                send_buffer(result, strlen(result)+1);
 
1387
                erl_free(result);
 
1388
            } else {
 
1389
                send_term(NULL);
 
1390
            }
 
1391
#endif
 
1392
        }
 
1393
    }
 
1394
}
 
1395
 
 
1396
 
 
1397
/***********************************************************************
 
1398
 *
 
1399
 *      5.   M i s c e l l a n o u s   T e s t s
 
1400
 *
 
1401
 ***********************************************************************/
 
1402
 
 
1403
/*
 
1404
 * Test some combinations of operations to verify that the reference pointers
 
1405
 * are handled correctly.
 
1406
 *
 
1407
 * "Det verkar vara lite High Chaparal med minneshanteringen i erl_interface"
 
1408
 * Per Lundgren, ERV.
 
1409
 */
 
1410
 
 
1411
TESTCASE(high_chaparal)
 
1412
{
 
1413
    ETERM *L1, *A1, *L2, *A2, *L3;
 
1414
 
 
1415
    erl_init(NULL, 0);
 
1416
 
 
1417
    L1 = erl_mk_empty_list();
 
1418
    A1 = erl_mk_atom("world");
 
1419
    L2 = erl_cons(A1, L1);
 
1420
    A2 = erl_mk_atom("hello");
 
1421
    L3 = erl_cons(A2, L2);
 
1422
 
 
1423
    erl_free_term(L1);
 
1424
    erl_free_term(A1);
 
1425
    erl_free_term(L2);
 
1426
    erl_free_term(A2);
 
1427
 
 
1428
    send_term(L3);
 
1429
 
 
1430
    /* already freed by send_term() */
 
1431
    /* erl_free_term(L3);*/
 
1432
 
 
1433
    report(1);
 
1434
}
 
1435
 
 
1436
/*
 
1437
 * Test erl_decode to recover from broken list data (OTP-7448)
 
1438
 */
 
1439
TESTCASE(broken_data)
 
1440
{
 
1441
    ETERM* original;
 
1442
    ETERM* new_terms;
 
1443
    char encoded[16*1024];
 
1444
    int n;
 
1445
 
 
1446
    erl_init(NULL, 0);
 
1447
    original = all_types();
 
1448
    if ((n=erl_encode(original, encoded)) == 0) 
 
1449
    {
 
1450
        fail("failed to encode terms");
 
1451
    } else 
 
1452
    {
 
1453
        int offs = n/2;
 
1454
        memset(encoded+offs,0,n-offs); /* destroy */
 
1455
 
 
1456
        if ((new_terms = erl_decode(encoded)) != NULL)
 
1457
        {
 
1458
            fail("decode accepted broken data");
 
1459
            erl_free_term(new_terms);
 
1460
        }
 
1461
    }
 
1462
    erl_free_term(original);
 
1463
    report(1);
 
1464
}
 
1465
 
 
1466
/*
 
1467
 * Returns a list containing instances of all types.
 
1468
 *
 
1469
 * Be careful changing the contents of the list returned, because both
 
1470
 * the build_terms() and decode_terms() test cases depend on it.
 
1471
 */
 
1472
 
 
1473
static ETERM*
 
1474
all_types(void)
 
1475
{
 
1476
    ETERM* t;
 
1477
    ETERM* terms[3];
 
1478
    int i;
 
1479
    static char a_binary[] = "A binary";
 
1480
 
 
1481
#define CONS_AND_FREE(expr, tail) \
 
1482
  do { \
 
1483
    ETERM* term = expr; \
 
1484
    ETERM* nl = erl_cons(term, tail); \
 
1485
    erl_free_term(term); \
 
1486
    erl_free_term(tail); \
 
1487
    tail = nl; \
 
1488
  } while (0)
 
1489
 
 
1490
    t = erl_mk_empty_list();
 
1491
 
 
1492
    CONS_AND_FREE(erl_mk_atom("I am an atom"), t);
 
1493
    CONS_AND_FREE(erl_mk_binary("A binary", sizeof(a_binary)-1), t);
 
1494
    CONS_AND_FREE(erl_mk_float(3.0), t);
 
1495
    CONS_AND_FREE(erl_mk_int(0), t);
 
1496
    CONS_AND_FREE(erl_mk_int(-1), t);
 
1497
    CONS_AND_FREE(erl_mk_int(1), t);
 
1498
 
 
1499
    CONS_AND_FREE(erl_mk_string("A string"), t);
 
1500
 
 
1501
    terms[0] = erl_mk_atom("element1");
 
1502
    terms[1] = erl_mk_int(42);
 
1503
    terms[2] = erl_mk_int(767);
 
1504
    CONS_AND_FREE(erl_mk_tuple(terms, ASIZE(terms)), t);
 
1505
    for (i = 0; i < ASIZE(terms); i++) {
 
1506
        erl_free_term(terms[i]);
 
1507
    }
 
1508
 
 
1509
    CONS_AND_FREE(erl_mk_pid("kalle@localhost", 3, 2, 1), t);
 
1510
    CONS_AND_FREE(erl_mk_pid("abcdefghijabcdefghij@localhost", 3, 2, 1), t);
 
1511
    CONS_AND_FREE(erl_mk_port("kalle@localhost", 4, 1), t);
 
1512
    CONS_AND_FREE(erl_mk_port("abcdefghijabcdefghij@localhost", 4, 1), t);
 
1513
    CONS_AND_FREE(erl_mk_ref("kalle@localhost", 6, 1), t);
 
1514
    CONS_AND_FREE(erl_mk_ref("abcdefghijabcdefghij@localhost", 6, 1), t);
 
1515
    return t;
 
1516
 
 
1517
#undef CONS_AND_FREE
 
1518
}
 
1519
 
 
1520
/*
 
1521
 * Dump (print for debugging) a term. Useful if/when things go wrong.
 
1522
 */
 
1523
void
 
1524
dump_term (FILE *fp, ETERM *t)
 
1525
{
 
1526
    if (fp == NULL) return;
 
1527
 
 
1528
    fprintf(fp, "#<%p ", t);
 
1529
 
 
1530
    if(t != NULL)
 
1531
    {
 
1532
        fprintf(fp, "count:%d, type:%d", ERL_COUNT(t), ERL_TYPE(t));
 
1533
 
 
1534
        switch(ERL_TYPE(t))
 
1535
        {
 
1536
        case ERL_UNDEF:
 
1537
            fprintf(fp, "==undef");
 
1538
            break;
 
1539
        case ERL_INTEGER:
 
1540
            fprintf(fp, "==int, val:%d", ERL_INT_VALUE(t));
 
1541
            break;
 
1542
        case ERL_U_INTEGER:
 
1543
            fprintf(fp, "==uint, val:%u", ERL_INT_UVALUE(t));
 
1544
            break;
 
1545
        case ERL_FLOAT:
 
1546
            fprintf(fp, "==float, val:%g", ERL_FLOAT_VALUE(t));
 
1547
            break;
 
1548
        case ERL_ATOM:
 
1549
            fprintf(fp, "==atom, name:%p \"%s\"", 
 
1550
                    ERL_ATOM_PTR(t), ERL_ATOM_PTR(t));
 
1551
            break;
 
1552
        case ERL_BINARY:
 
1553
            fprintf(fp, "==binary, data:%p,%u",
 
1554
                    ERL_BIN_PTR(t), ERL_BIN_SIZE(t));
 
1555
            break;
 
1556
        case ERL_PID:
 
1557
            fprintf(fp, "==pid, node:%p \"%s\"",
 
1558
                    ERL_PID_NODE(t), ERL_PID_NODE(t));
 
1559
            break;
 
1560
        case ERL_PORT:
 
1561
            fprintf(fp, "==port, node:%p \"%s\"",
 
1562
                    ERL_PORT_NODE(t), ERL_PORT_NODE(t));
 
1563
            break;
 
1564
        case ERL_REF:
 
1565
            fprintf(fp, "==ref, node:%p \"%s\"",
 
1566
                    ERL_REF_NODE(t), ERL_REF_NODE(t));
 
1567
            break;
 
1568
        case ERL_CONS:
 
1569
            fprintf(fp, "==cons");
 
1570
            fprintf(fp, ", car:");
 
1571
            dump_term(fp, ERL_CONS_HEAD(t));
 
1572
            fprintf(fp, ", cdr:");
 
1573
            dump_term(fp, ERL_CONS_TAIL(t));
 
1574
            break;
 
1575
        case ERL_NIL:
 
1576
            fprintf(fp, "==nil");
 
1577
            break;
 
1578
        case ERL_TUPLE:
 
1579
            fprintf(fp, "==tuple, elems:%p,%u", 
 
1580
                    ERL_TUPLE_ELEMS(t), ERL_TUPLE_SIZE(t));
 
1581
            {
 
1582
                size_t i;
 
1583
                for(i = 0; i < ERL_TUPLE_SIZE(t); i++)
 
1584
                {
 
1585
                    fprintf(fp, "elem[%u]:", i);
 
1586
                    dump_term(fp, ERL_TUPLE_ELEMENT(t, i));                 
 
1587
                }
 
1588
            }
 
1589
            break;
 
1590
        case ERL_VARIABLE:
 
1591
            fprintf(fp, "==variable, name:%p \"%s\"",
 
1592
                    ERL_VAR_NAME(t), ERL_VAR_NAME(t));
 
1593
            fprintf(fp, ", value:");
 
1594
            dump_term(fp, ERL_VAR_VALUE(t));        
 
1595
            break;
 
1596
 
 
1597
        default:
 
1598
            break;
 
1599
        }
 
1600
    }
 
1601
    fprintf(fp, ">");
 
1602
}
 
1603