t/src/extend.t

   1 #!perl
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test::Util 'create_tempfile';
  11
  12 use Parrot::Test;
  13 use Parrot::Config;
  14
  15 plan tests => 18;
  16
  17 =head1 NAME
  18
  19 t/src/extend.t - Parrot Extension API
  20
  21 =head1 SYNOPSIS
  22
  23     % prove t/src/extend.t
  24
  25 =head1 DESCRIPTION
  26
  27 Tests the extension API.
  28
  29 =cut
  30
  31 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_intreg' );
  32
  33 #include <stdio.h>
  34 #include "parrot/embed.h"
  35 #include "parrot/extend.h"
  36
  37 int
  38 main(int argc, const char *argv[])
  39 {
  40     Parrot_Interp interp  = Parrot_new(NULL);
  41     Parrot_Int    parrot_reg = 0;
  42     Parrot_Int    value      = 42;
  43     Parrot_Int    new_value;
  44
  45     /* Interpreter set-up */
  46     if (interp) {
  47         Parrot_set_intreg(interp, parrot_reg, value);
  48         new_value = Parrot_get_intreg(interp, parrot_reg);
  49
  50         printf("%d\n", (int)new_value);
  51         Parrot_destroy(interp);
  52     }
  53     return 0;
  54 }
  55
  56 CODE
  57 42
  58 OUTPUT
  59
  60 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_numreg' );
  61
  62 #include <stdio.h>
  63 #include "parrot/embed.h"
  64 #include "parrot/extend.h"
  65
  66 int
  67 main(int argc, const char *argv[])
  68 {
  69     Parrot_Interp interp     = Parrot_new(NULL);
  70     Parrot_Int    parrot_reg = 1;
  71     Parrot_Float  value       = 2.5;
  72     Parrot_Float  new_value;
  73
  74     /* Interpreter set-up */
  75     if (interp) {
  76         Parrot_set_numreg(interp, parrot_reg, value);
  77         new_value = Parrot_get_numreg(interp, parrot_reg);
  78
  79         printf("%.1f\n", (double)new_value);
  80
  81         Parrot_destroy(interp);
  82     }
  83     return 0;
  84 }
  85
  86 CODE
  87 2.5
  88 OUTPUT
  89
  90 c_output_is( <<'CODE', <<'OUTPUT', 'Parrot_new_string' );
  91
  92 #include <stdio.h>
  93 #include "parrot/embed.h"
  94 #include "parrot/extend.h"
  95
  96 int
  97 main(int argc, const char *argv[])
  98 {
  99     Parrot_Interp interp = Parrot_new(NULL);
 100     Parrot_String output;
 101
 102     /* Interpreter set-up */
 103     if (interp) {
 104         output = Parrot_new_string(interp, "Test", 4, "iso-8859-1", 0);
 105         Parrot_eprintf(interp, "%S\n", output);
 106
 107         Parrot_destroy(interp);
 108     }
 109     return 0;
 110 }
 111
 112 CODE
 113 Test
 114 OUTPUT
 115
 116 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_strreg' );
 117
 118 #include <stdio.h>
 119 #include "parrot/embed.h"
 120 #include "parrot/extend.h"
 121
 122 int
 123 main(int argc, const char *argv[])
 124 {
 125     Parrot_Interp interp     = Parrot_new(NULL);
 126     Parrot_Int    parrot_reg = 2;
 127     Parrot_String value, new_value;
 128
 129     /* Interpreter set-up */
 130     if (interp) {
 131         value = Parrot_new_string(interp, "Test", 4, "iso-8859-1", 0);
 132         Parrot_set_strreg(interp, parrot_reg, value);
 133
 134         new_value = Parrot_get_strreg(interp, parrot_reg);
 135         Parrot_eprintf(interp, "%S\n", new_value);
 136
 137         Parrot_destroy(interp);
 138     }
 139     return 0;
 140 }
 141
 142 CODE
 143 Test
 144 OUTPUT
 145
 146 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_integer' );
 147
 148 #include <stdio.h>
 149 #include "parrot/embed.h"
 150 #include "parrot/extend.h"
 151
 152 int
 153 main(int argc, const char *argv[])
 154 {
 155     Parrot_Interp interp = Parrot_new(NULL);
 156     Parrot_Int    value  = 101010;
 157     Parrot_PMC    testpmc;
 158     Parrot_Int    type, new_value;
 159
 160     /* Interpreter set-up */
 161     if (interp) {
 162         type    = Parrot_PMC_typenum(interp, "Integer");
 163         testpmc = Parrot_PMC_new(interp, type);
 164
 165         Parrot_PMC_set_integer_native(interp, testpmc, value);
 166         new_value = Parrot_PMC_get_integer(interp, testpmc);
 167
 168         printf("%ld\n", (long)new_value);
 169
 170         Parrot_destroy(interp);
 171     }
 172     return 0;
 173 }
 174 CODE
 175 101010
 176 OUTPUT
 177
 178 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_integer_keyed_int' );
 179
 180 #include <stdio.h>
 181 #include "parrot/parrot.h"
 182 #include "parrot/embed.h"
 183 #include "parrot/extend.h"
 184
 185 static opcode_t*
 186 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 187 {
 188     Parrot_Int type  = Parrot_PMC_typenum(interp, "ResizablePMCArray");
 189     Parrot_PMC array = Parrot_PMC_new(interp, type);
 190     Parrot_Int value = 12345;
 191     Parrot_Int key   = 10;
 192     Parrot_Int new_value;
 193
 194     Parrot_PMC_set_integer_keyed_int(interp, array, key, value);
 195
 196     new_value = Parrot_PMC_get_integer_keyed_int(interp, array, key);
 197
 198     printf("%ld\n", (long)new_value);
 199     return NULL;
 200 }
 201
 202 int
 203 main(int argc, const char *argv[])
 204 {
 205     Parrot_Interp interp = Parrot_new(NULL);
 206
 207     /* Interpreter set-up */
 208     if (interp) {
 209         Parrot_run_native(interp, the_test);
 210
 211         Parrot_destroy(interp);
 212     }
 213     return 0;
 214 }
 215 CODE
 216 12345
 217 OUTPUT
 218
 219 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_pmcreg' );
 220
 221 #include <stdio.h>
 222 #include "parrot/embed.h"
 223 #include "parrot/extend.h"
 224
 225 int
 226 main(int argc, const char *argv[])
 227 {
 228     Parrot_Interp interp     = Parrot_new(NULL);
 229     Parrot_Int    value      = -123;
 230     Parrot_Int    parrot_reg =  31;
 231     Parrot_Int    type, new_value;
 232     Parrot_PMC    testpmc, newpmc;
 233
 234     /* Interpreter set-up */
 235     if (interp) {
 236         type    = Parrot_PMC_typenum(interp, "Integer");
 237         testpmc = Parrot_PMC_new(interp, type);
 238
 239         Parrot_PMC_set_integer_native(interp, testpmc, value);
 240
 241         parrot_reg = 31;
 242         Parrot_set_pmcreg(interp, parrot_reg, testpmc);
 243
 244         newpmc    = Parrot_get_pmcreg(interp, parrot_reg);
 245         new_value = Parrot_PMC_get_integer(interp, newpmc);
 246
 247         printf("%d\n", (int)new_value);
 248
 249         Parrot_destroy(interp);
 250     }
 251     return 0;
 252 }
 253 CODE
 254 -123
 255 OUTPUT
 256
 257 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_number' );
 258
 259 #include <stdio.h>
 260 #include "parrot/embed.h"
 261 #include "parrot/extend.h"
 262
 263 int
 264 main(int argc, const char *argv[])
 265 {
 266     Parrot_Interp interp = Parrot_new(NULL);
 267     Parrot_Float  value  = 3.1415927;
 268     Parrot_Int    type;
 269     Parrot_Float  new_value;
 270     Parrot_PMC    testpmc;
 271
 272     /* Interpreter set-up */
 273     if (interp) {
 274         type    = Parrot_PMC_typenum(interp, "Float");
 275         testpmc = Parrot_PMC_new(interp, type);
 276
 277         Parrot_PMC_set_number_native(interp, testpmc, value);
 278         new_value = Parrot_PMC_get_number(interp, testpmc);
 279
 280         printf("%.7f\n", (double)new_value);
 281
 282         Parrot_destroy(interp);
 283     }
 284     return 0;
 285 }
 286 CODE
 287 3.1415927
 288 OUTPUT
 289
 290 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_string' );
 291
 292 #include <stdio.h>
 293 #include "parrot/embed.h"
 294 #include "parrot/extend.h"
 295
 296 int
 297 main(int argc, const char *argv[])
 298 {
 299     Parrot_Interp interp = Parrot_new(NULL);
 300     Parrot_Int    type;
 301     Parrot_String value, new_value;
 302     Parrot_PMC    testpmc;
 303
 304     /* Interpreter set-up */
 305     if (interp) {
 306         type    = Parrot_PMC_typenum(interp, "String");
 307         testpmc = Parrot_PMC_new(interp, type);
 308
 309         value     = Parrot_new_string(interp, "Pumpking", 8, "iso-8859-1", 0);
 310         Parrot_PMC_set_string_native(interp, testpmc, value);
 311         new_value = Parrot_PMC_get_string(interp, testpmc);
 312
 313         Parrot_eprintf(interp, "%S\n", new_value);
 314
 315         Parrot_destroy(interp);
 316     }
 317     return 0;
 318 }
 319 CODE
 320 Pumpking
 321 OUTPUT
 322
 323 my ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 324
 325 print $TEMP <<'EOF';
 326   .pcc_sub _sub1:
 327   get_params ""
 328   print "in sub1\n"
 329   set_returns ""
 330   returncc
 331   .pcc_sub _sub2:
 332   get_params "0", P5
 333   print P5
 334   print "in sub2\n"
 335   set_returns ""
 336   returncc
 337 EOF
 338 close $TEMP;
 339
 340 # compile to pbc
 341 my (undef, $temp_pbc) = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
 342 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm);
 343
 344 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub' );
 345
 346 #include <parrot/parrot.h>
 347 #include <parrot/embed.h>
 348 #include <parrot/extend.h>
 349
 350 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 351
 352 int
 353 main(int argc, const char *argv[])
 354 {
 355     Parrot_Interp interp = Parrot_new(NULL);
 356     if (interp) {
 357
 358         Parrot_run_native(interp, the_test);
 359
 360         Parrot_destroy(interp);
 361     }
 362     return 0;
 363 }
 364
 365 /* also both the test PASM and the_test() print to stderr
 366  * so that buffering in PIO is not an issue */
 367
 368 static opcode_t*
 369 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 370 {
 371     PackFile      *pf   = Parrot_pbc_read(interp, "$temp_pbc", 0);
 372     Parrot_String  name = Parrot_str_new_constant(interp, "_sub1");
 373     PMC           *sub, *arg;
 374
 375     Parrot_pbc_load(interp, pf);
 376     sub = Parrot_ns_find_current_namespace_global(interp, name);
 377     Parrot_ext_call(interp, sub, "->");
 378     Parrot_eprintf(interp, "back\\n");
 379
 380     /* win32 seems to buffer stderr ? */
 381     Parrot_io_flush(interp, Parrot_io_STDERR(interp));
 382
 383     name = Parrot_str_new_constant(interp, "_sub2");
 384     sub  = Parrot_ns_find_current_namespace_global(interp, name);
 385     arg  = Parrot_pmc_new(interp, enum_class_String);
 386
 387     Parrot_PMC_set_string_native(interp, arg,
 388                  Parrot_str_new(interp, "hello ", 0));
 389
 390     Parrot_ext_call(interp, sub, "P->", arg);
 391     Parrot_eprintf(interp, "back\\n");
 392
 393     return NULL;
 394 }
 395 CODE
 396 in sub1
 397 back
 398 hello in sub2
 399 back
 400 OUTPUT
 401
 402 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub using the unified interface' );
 403
 404 #include <parrot/parrot.h>
 405 #include <parrot/embed.h>
 406 #include <parrot/extend.h>
 407
 408 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 409
 410 int
 411 main(int argc, const char *argv[])
 412 {
 413     Parrot_Interp interp = Parrot_new(NULL);
 414     if (interp) {
 415         Parrot_run_native(interp, the_test);
 416
 417         Parrot_destroy(interp);
 418     }
 419     return 0;
 420 }
 421
 422 /* also both the test PASM and the_test() print to stderr
 423  * so that buffering in PIO is not an issue */
 424
 425 static opcode_t*
 426 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 427 {
 428     PackFile      *pf   = Parrot_pbc_read(interp, "$temp_pbc", 0);
 429     Parrot_String  name = Parrot_str_new_constant(interp, "_sub1");
 430     PMC           *sub, *arg;
 431
 432     Parrot_pbc_load(interp, pf);
 433     sub = Parrot_ns_find_current_namespace_global(interp, name);
 434     Parrot_ext_call(interp, sub, "->");
 435     Parrot_eprintf(interp, "back\\n");
 436
 437     /* win32 seems to buffer stderr ? */
 438     Parrot_io_flush(interp, Parrot_io_STDERR(interp));
 439
 440     name = Parrot_str_new_constant(interp, "_sub2");
 441     sub  = Parrot_ns_find_current_namespace_global(interp, name);
 442     arg  = Parrot_pmc_new(interp, enum_class_String);
 443
 444     Parrot_PMC_set_string_native(interp, arg,
 445                  Parrot_str_new(interp, "hello ", 0));
 446
 447     Parrot_ext_call(interp, sub, "P->", arg);
 448     Parrot_eprintf(interp, "back\\n");
 449
 450     return NULL;
 451 }
 452 CODE
 453 in sub1
 454 back
 455 hello in sub2
 456 back
 457 OUTPUT
 458
 459 ($TEMP, my $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 460
 461 print $TEMP <<'EOF';
 462   .sub foo
 463       .param pmc input
 464       print input
 465       print "in sub2\n"
 466       $P0 = new "Integer"
 467       $P0 = 42
 468       .return($P0)
 469   .end
 470 EOF
 471 close $TEMP;
 472
 473 # compile to pbc
 474 (undef, $temp_pbc) = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
 475 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir);
 476
 477 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub and return an integer' );
 478
 479 #include <parrot/parrot.h>
 480 #include <parrot/embed.h>
 481 #include <parrot/extend.h>
 482
 483 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 484
 485 int
 486 main(int argc, const char *argv[])
 487 {
 488     Parrot_Interp interp = Parrot_new(NULL);
 489     if (interp) {
 490         Parrot_run_native(interp, the_test);
 491
 492         Parrot_destroy(interp);
 493     }
 494     return 0;
 495 }
 496
 497 /* also both the test PASM and the_test() print to stderr
 498  * so that buffering in PIO is not an issue */
 499
 500 static opcode_t*
 501 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 502 {
 503     PackFile      *pf   = Parrot_pbc_read(interp, "$temp_pbc", 0);
 504     Parrot_String  name = Parrot_str_new_constant(interp, "foo");
 505     PMC           *sub, *arg;
 506     Parrot_Int     result;
 507
 508     Parrot_pbc_load(interp, pf);
 509     sub  = Parrot_ns_find_current_namespace_global(interp, name);
 510     arg  = Parrot_pmc_new(interp, enum_class_String);
 511
 512     Parrot_PMC_set_string_native(interp, arg,
 513                  Parrot_str_new(interp, "hello ", 0));
 514
 515     Parrot_ext_call(interp, sub, "P->I", arg, &result);
 516     Parrot_eprintf(interp, "result %d\\n", result);
 517     Parrot_eprintf(interp, "back\\n");
 518
 519     return NULL;
 520 }
 521 CODE
 522 hello in sub2
 523 result 42
 524 back
 525 OUTPUT
 526
 527 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 528
 529 print $TEMP <<'EOF';
 530   .pcc_sub _sub1:
 531   get_params ""
 532   print "in sub1\n"
 533   set I1, 0                             # Divide by 0 to force exception.
 534   div I2, I1, 0
 535   print "never\n"
 536   returncc
 537 EOF
 538 close $TEMP;
 539
 540 # compile to pbc
 541 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm);
 542
 543 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub, catch exception' );
 544
 545 #include <parrot/parrot.h>
 546 #include <parrot/embed.h>
 547 #include <parrot/extend.h>
 548
 549 static opcode_t *
 550 the_test(Parrot_Interp, opcode_t *, opcode_t *);
 551
 552 int
 553 main(int argc, const char *argv[])
 554 {
 555     Parrot_Interp interp = Parrot_new(NULL);
 556     if (interp) {
 557         Parrot_run_native(interp, the_test);
 558
 559         Parrot_destroy(interp);
 560     }
 561     return 0;
 562 }
 563
 564 /* also both the test PASM and the_test() print to stderr
 565  * so that buffering in PIO is not an issue */
 566
 567 static opcode_t*
 568 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 569 {
 570     PackFile      *pf   = Parrot_pbc_read(interp, "$temp_pbc", 0);
 571     Parrot_String  name = Parrot_str_new_constant(interp, "_sub1");
 572     PMC           *sub;
 573     Parrot_runloop jump_point;
 574
 575     Parrot_pbc_load(interp, pf);
 576     sub = Parrot_ns_find_current_namespace_global(interp, name);
 577
 578     if (setjmp(jump_point.resume)) {
 579         Parrot_eprintf(interp, "caught\\n");
 580     }
 581     else {
 582         /* pretend the EH was pushed by the sub call. */
 583         interp->current_runloop_id++;
 584
 585         Parrot_ex_add_c_handler(interp, &jump_point);
 586         Parrot_ext_call(interp, sub, "->");
 587     }
 588
 589     Parrot_eprintf(interp, "back\\n");
 590
 591     return NULL;
 592 }
 593 CODE
 594 in sub1
 595 caught
 596 back
 597 OUTPUT
 598
 599 ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 600
 601 print $TEMP <<'EOF';
 602 .sub main :main
 603     .param pmc argv
 604
 605     .local pmc compiler
 606     compreg compiler, 'PIR'
 607
 608     .local string code
 609     code = argv[0]
 610
 611     .local pmc compiled_sub
 612     compiled_sub = compiler( code )
 613
 614     compiled_sub()
 615     end
 616 .end
 617
 618 .sub add :multi( int, int )
 619     .param int l
 620     .param int r
 621
 622     .local int sum
 623     sum = l + r
 624     .return( sum )
 625 .end
 626
 627 .sub add :multi( num, num )
 628     .param num l
 629     .param num r
 630
 631     .local num sum
 632     sum = l + r
 633     .return( sum )
 634 .end
 635 EOF
 636 close $TEMP;
 637
 638 # compile to pbc
 639 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir);
 640
 641 c_output_is( <<"CODE", <<'OUTPUT', 'eval code through a parrot sub - #39669' );
 642
 643 #include <parrot/parrot.h>
 644 #include <parrot/embed.h>
 645
 646 int
 647 main(int argc, const char *argv[])
 648 {
 649     Parrot_PackFile packfile;
 650     const char * code[] = { ".sub foo\\nsay \\"Hello from foo!\\"\\n.end\\n" };
 651
 652     Parrot_Interp interp = Parrot_new(NULL);
 653     if (interp) {
 654         packfile = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 655
 656         if (packfile) {
 657             Parrot_pbc_load( interp, packfile );
 658             Parrot_runcode( interp, 1, code );
 659         }
 660
 661         Parrot_destroy( interp );
 662     }
 663     return 0;
 664 }
 665 CODE
 666 Hello from foo!
 667 OUTPUT
 668
 669 c_output_is( <<'CODE', <<'OUTPUT', 'compile string in a fresh interp - #39986' );
 670
 671 #include <parrot/parrot.h>
 672 #include <parrot/embed.h>
 673 #include <parrot/extend.h>
 674
 675 int
 676 main(int argc, const char *argv[])
 677 {
 678     Parrot_Interp   interp    = Parrot_new(NULL);
 679     const char      *code      = ".sub foo\nprint\"Hello from foo!\\n\"\n.end\n";
 680     Parrot_PMC      retval;
 681     Parrot_PMC      sub;
 682     Parrot_String   code_type, error, foo_name;
 683
 684     if (interp) {
 685         code_type = Parrot_str_new_constant( interp, "PIR" );
 686         retval    = Parrot_compile_string( interp, code_type, code, &error );
 687
 688         if (retval) {
 689             foo_name = Parrot_str_new_constant( interp, "foo" );
 690             sub      = Parrot_ns_find_current_namespace_global( interp, foo_name );
 691
 692             Parrot_ext_call(interp, sub, "->");
 693         }
 694         Parrot_destroy(interp);
 695     }
 696     return 0;
 697 }
 698 CODE
 699 Hello from foo!
 700 OUTPUT
 701
 702 c_output_is( <<"CODE", <<'OUTPUT', 'call multi sub from C - #41511' );
 703 #include <parrot/parrot.h>
 704 #include <parrot/embed.h>
 705 #include <parrot/extend.h>
 706
 707 int
 708 main(int argc, const char *argv[])
 709 {
 710     Parrot_Int      result;
 711     Parrot_PMC      sub;
 712     Parrot_PackFile pf;
 713     Parrot_Interp   interp = Parrot_new(NULL);
 714
 715     if (interp) {
 716         pf = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 717         Parrot_pbc_load( interp, pf );
 718
 719         sub      = Parrot_ns_find_current_namespace_global( interp, Parrot_str_new_constant( interp, "add" ) );
 720         Parrot_ext_call(interp, sub, "II->I", 100, 200, &result);
 721         printf( "Result is %d.\\n", result );
 722         Parrot_destroy(interp);
 723     }
 724     return 0;
 725 }
 726 CODE
 727 Result is 300.
 728 OUTPUT
 729
 730 c_output_is( <<"CODE", <<'OUTPUT', 'call multi sub from C - unified interface' );
 731 #include <parrot/parrot.h>
 732 #include <parrot/embed.h>
 733 #include <parrot/extend.h>
 734
 735 int
 736 main(int argc, const char *argv[])
 737 {
 738     Parrot_Int      result;
 739     Parrot_PMC      sub;
 740     Parrot_PackFile pf;
 741     Parrot_Interp   interp = Parrot_new(NULL);
 742
 743     if (interp) {
 744         pf = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 745         Parrot_pbc_load( interp, pf );
 746
 747         sub      = Parrot_ns_find_current_namespace_global( interp, Parrot_str_new_constant( interp, "add" ) );
 748         Parrot_ext_call( interp, sub, "II->I", 100, 200, &result );
 749         printf( "Result is %d.\\n", result );
 750         Parrot_destroy(interp);
 751     }
 752     return 0;
 753 }
 754 CODE
 755 Result is 300.
 756 OUTPUT
 757
 758 c_output_is( <<'CODE', <<'OUTPUT', 'multiple Parrot_new/Parrot_exit cycles' );
 759
 760 #include <stdio.h>
 761 #include "parrot/parrot.h"
 762 #include "parrot/embed.h"
 763
 764 /* this is Parrot_exit without the exit()
 765  * it will call Parrot_really_destroy() as an exit handler
 766  */
 767 void interp_cleanup(Parrot_Interp, int);
 768
 769 void interp_cleanup(PARROT_INTERP, int status)
 770 {
 771     handler_node_t *node = interp->exit_handler_list;
 772
 773     Parrot_block_GC_mark(interp);
 774     Parrot_block_GC_sweep(interp);
 775
 776     while (node) {
 777         handler_node_t * const next = node->next;
 778         (node->function)(interp, status, node->arg);
 779         mem_sys_free(node);
 780         node = next;
 781     }
 782 }
 783
 784 int
 785 main(int argc, const char *argv[])
 786 {
 787     Parrot_Interp interp;
 788     int i, niter = 2;
 789
 790     for (i = 1; i <= niter; i++) {
 791         printf("Starting interp %d\n", i);
 792         fflush(stdout);
 793         interp = Parrot_new(NULL);
 794         if (interp) {
 795             Parrot_set_flag(interp, PARROT_DESTROY_FLAG);
 796
 797             printf("Destroying interp %d\n", i);
 798             fflush(stdout);
 799             interp_cleanup(interp, 0);
 800         }
 801     }
 802
 803     return 0;
 804 }
 805
 806 CODE
 807 Starting interp 1
 808 Destroying interp 1
 809 Starting interp 2
 810 Destroying interp 2
 811 OUTPUT
 812
 813 # Local Variables:
 814 #   mode: cperl
 815 #   cperl-indent-level: 4
 816 #   fill-column: 100
 817 # End:
 818 # vim: expandtab shiftwidth=4: