t/src/extend.t

   1 #!perl
   2 # Copyright (C) 2001-2009, 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 => 20;
  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, char* argv[]) {
  39     Parrot_Interp interp  = Parrot_new(NULL);
  40     Parrot_Int    parrot_reg = 0;
  41     Parrot_Int    value      = 42;
  42     Parrot_Int    new_value;
  43
  44     /* Interpreter set-up */
  45     if (!interp)
  46         return 1;
  47
  48     Parrot_set_intreg(interp, parrot_reg, value);
  49     new_value = Parrot_get_intreg(interp, parrot_reg);
  50
  51     printf("%d\n", (int)new_value);
  52
  53     Parrot_exit(interp, 0);
  54     return 0;
  55 }
  56
  57 CODE
  58 42
  59 OUTPUT
  60
  61 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_numreg' );
  62
  63 #include <stdio.h>
  64 #include "parrot/embed.h"
  65 #include "parrot/extend.h"
  66
  67 int
  68 main(int argc, char* argv[]) {
  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         return 1;
  77
  78     Parrot_set_numreg(interp, parrot_reg, value);
  79     new_value = Parrot_get_numreg(interp, parrot_reg);
  80
  81     printf("%.1f\n", (double)new_value);
  82
  83     Parrot_exit(interp, 0);
  84     return 0;
  85 }
  86
  87 CODE
  88 2.5
  89 OUTPUT
  90
  91 c_output_is( <<'CODE', <<'OUTPUT', 'Parrot_new_string' );
  92
  93 #include <stdio.h>
  94 #include "parrot/embed.h"
  95 #include "parrot/extend.h"
  96
  97 int
  98 main(int argc, char* argv[]) {
  99     Parrot_Interp interp = Parrot_new(NULL);
 100     Parrot_String output;
 101
 102     /* Interpreter set-up */
 103     if (!interp)
 104         return 1;
 105
 106     output = Parrot_new_string(interp, "Test", 4, "iso-8859-1", 0);
 107     Parrot_eprintf(interp, "%S\n", output);
 108
 109     Parrot_exit(interp, 0);
 110     return 0;
 111 }
 112
 113 CODE
 114 Test
 115 OUTPUT
 116
 117 c_output_is( <<'CODE', <<'OUTPUT', 'set/get_strreg' );
 118
 119 #include <stdio.h>
 120 #include "parrot/embed.h"
 121 #include "parrot/extend.h"
 122
 123 int
 124 main(int argc, char* argv[]) {
 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         return 1;
 132
 133     value = Parrot_new_string(interp, "Test", 4, "iso-8859-1", 0);
 134     Parrot_set_strreg(interp, parrot_reg, value);
 135
 136     new_value = Parrot_get_strreg(interp, parrot_reg);
 137     Parrot_eprintf(interp, "%S\n", new_value);
 138
 139     Parrot_exit(interp, 0);
 140     return 0;
 141 }
 142
 143 CODE
 144 Test
 145 OUTPUT
 146
 147 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_intval' );
 148
 149 #include <stdio.h>
 150 #include "parrot/embed.h"
 151 #include "parrot/extend.h"
 152
 153 int
 154 main(int argc, char* argv[]) {
 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         return 1;
 163
 164     type    = Parrot_PMC_typenum(interp, "Integer");
 165     testpmc = Parrot_PMC_new(interp, type);
 166
 167     Parrot_PMC_set_intval(interp, testpmc, value);
 168     new_value = Parrot_PMC_get_intval(interp, testpmc);
 169
 170     printf("%ld\n", (long)new_value);
 171
 172     Parrot_exit(interp, 0);
 173     return 0;
 174 }
 175 CODE
 176 101010
 177 OUTPUT
 178
 179 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_intval_intkey' );
 180
 181 #include <stdio.h>
 182 #include "parrot/parrot.h"
 183 #include "parrot/embed.h"
 184 #include "parrot/extend.h"
 185
 186 static opcode_t*
 187 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 188 {
 189     Parrot_Int type  = Parrot_PMC_typenum(interp, "ResizablePMCArray");
 190     Parrot_PMC array = Parrot_PMC_new(interp, type);
 191     Parrot_Int value = 12345;
 192     Parrot_Int key   = 10;
 193     Parrot_Int new_value;
 194
 195     Parrot_PMC_set_intval_intkey(interp, array, key, value);
 196
 197     new_value = Parrot_PMC_get_intval_intkey(interp, array, key);
 198
 199     printf("%ld\n", (long)new_value);
 200     return NULL;
 201 }
 202
 203 int
 204 main(int argc, char* argv[]) {
 205     Parrot_Interp interp = Parrot_new(NULL);
 206
 207     /* Interpreter set-up */
 208     if (!interp)
 209         return 1;
 210
 211     Parrot_run_native(interp, the_test);
 212     Parrot_exit(interp, 0);
 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, char* argv[]) {
 227     Parrot_Interp interp     = Parrot_new(NULL);
 228     Parrot_Int    value      = -123;
 229     Parrot_Int    parrot_reg =  31;
 230     Parrot_Int    type, new_value;
 231     Parrot_PMC    testpmc, newpmc;
 232
 233     /* Interpreter set-up */
 234     if (!interp)
 235         return 1;
 236
 237     type    = Parrot_PMC_typenum(interp, "Integer");
 238     testpmc = Parrot_PMC_new(interp, type);
 239
 240     Parrot_PMC_set_intval(interp, testpmc, value);
 241
 242     parrot_reg = 31;
 243     Parrot_set_pmcreg(interp, parrot_reg, testpmc);
 244
 245     newpmc    = Parrot_get_pmcreg(interp, parrot_reg);
 246     new_value = Parrot_PMC_get_intval(interp, newpmc);
 247
 248     printf("%d\n", (int)new_value);
 249
 250     Parrot_exit(interp, 0);
 251     return 0;
 252 }
 253 CODE
 254 -123
 255 OUTPUT
 256
 257 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_numval' );
 258
 259 #include <stdio.h>
 260 #include "parrot/embed.h"
 261 #include "parrot/extend.h"
 262
 263 int
 264 main(int argc, char* argv[]) {
 265     Parrot_Interp interp = Parrot_new(NULL);
 266     Parrot_Float  value  = 3.1415927;
 267     Parrot_Int    type;
 268     Parrot_Float  new_value;
 269     Parrot_PMC    testpmc;
 270
 271     /* Interpreter set-up */
 272     if (!interp)
 273         return 1;
 274
 275     type    = Parrot_PMC_typenum(interp, "Float");
 276     testpmc = Parrot_PMC_new(interp, type);
 277
 278     Parrot_PMC_set_numval(interp, testpmc, value);
 279     new_value = Parrot_PMC_get_numval(interp, testpmc);
 280
 281     printf("%.7f\n", (double)new_value);
 282
 283     Parrot_exit(interp, 0);
 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, char* argv[]) {
 298     Parrot_Interp interp = Parrot_new(NULL);
 299     Parrot_Int    type;
 300     Parrot_String value, new_value;
 301     Parrot_PMC    testpmc;
 302
 303     /* Interpreter set-up */
 304     if (!interp)
 305         return 1;
 306
 307     type    = Parrot_PMC_typenum(interp, "String");
 308     testpmc = Parrot_PMC_new(interp, type);
 309
 310     value     = Parrot_new_string(interp, "Pumpking", 8, "iso-8859-1", 0);
 311     Parrot_PMC_set_string(interp, testpmc, value);
 312     new_value = Parrot_PMC_get_string(interp, testpmc);
 313
 314     Parrot_eprintf(interp, "%S\n", new_value);
 315
 316     Parrot_exit(interp, 0);
 317     return 0;
 318 }
 319 CODE
 320 Pumpking
 321 OUTPUT
 322
 323 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_cstring' );
 324
 325 #include <stdio.h>
 326 #include "parrot/embed.h"
 327 #include "parrot/extend.h"
 328
 329 int
 330 main(int argc, char* argv[]) {
 331     Parrot_Interp interp = Parrot_new(NULL);
 332     Parrot_Int    type;
 333     Parrot_PMC    testpmc;
 334     char         *new_value;
 335
 336     /* Interpreter set-up */
 337     if (!interp)
 338         return 1;
 339
 340     type    = Parrot_PMC_typenum(interp, "String");
 341     testpmc = Parrot_PMC_new(interp, type);
 342
 343     Parrot_PMC_set_cstring(interp, testpmc, "Wibble");
 344     new_value = Parrot_PMC_get_cstring(interp, testpmc);
 345
 346     printf("%s\n", new_value);
 347
 348     Parrot_free_cstring(new_value);
 349
 350     Parrot_exit(interp, 0);
 351     return 0;
 352 }
 353 CODE
 354 Wibble
 355 OUTPUT
 356
 357 c_output_is( <<'CODE', <<'OUTPUT', 'PMC_set/get_cstringn' );
 358
 359 #include <stdio.h>
 360 #include "parrot/embed.h"
 361 #include "parrot/extend.h"
 362
 363 int
 364 main(int argc, char* argv[]) {
 365     Parrot_Interp interp = Parrot_new(NULL);
 366     Parrot_Int    length = 6;
 367     Parrot_Int    type;
 368     Parrot_Int    new_len;
 369     Parrot_PMC    testpmc;
 370     char         *new_value;
 371
 372     /* Interpreter set-up */
 373     if (!interp)
 374         return 1;
 375
 376     type    = Parrot_PMC_typenum(interp, "String");
 377     testpmc = Parrot_PMC_new(interp, type);
 378
 379     Parrot_PMC_set_cstringn(interp, testpmc, "Wibble", length);
 380     new_value = Parrot_PMC_get_cstringn(interp, testpmc, &new_len);
 381
 382     printf("%s\n", new_value);
 383     printf("%d\n", (int)(new_len));
 384
 385     Parrot_free_cstring(new_value);
 386
 387     Parrot_exit(interp, 0);
 388     return 0;
 389 }
 390 CODE
 391 Wibble
 392 6
 393 OUTPUT
 394
 395 my ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 396
 397 print $TEMP <<'EOF';
 398   .pcc_sub _sub1:
 399   get_params ""
 400   printerr "in sub1\n"
 401   set_returns ""
 402   returncc
 403   .pcc_sub _sub2:
 404   get_params "0", P5
 405   printerr P5
 406   printerr "in sub2\n"
 407   set_returns ""
 408   returncc
 409 EOF
 410 close $TEMP;
 411
 412 # compile to pbc
 413 my (undef, $temp_pbc) = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
 414 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm);
 415
 416 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub' );
 417
 418 #include <parrot/parrot.h>
 419 #include <parrot/embed.h>
 420 #include <parrot/extend.h>
 421
 422 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 423
 424 int
 425 main(int argc, char *argv[])
 426 {
 427     Parrot_Interp interp = Parrot_new(NULL);
 428     if (!interp)
 429         return 1;
 430
 431     Parrot_run_native(interp, the_test);
 432
 433     Parrot_exit(interp, 0);
 434     return 0;
 435 }
 436
 437 /* also both the test PASM and the_test() print to stderr
 438  * so that buffering in PIO is not an issue */
 439
 440 static opcode_t*
 441 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 442 {
 443     PackFile *pf = Parrot_pbc_read(interp, "$temp_pbc", 0);
 444     STRING   *name = Parrot_str_new_constant(interp, "_sub1");
 445     PMC      *sub, *arg;
 446
 447     Parrot_pbc_load(interp, pf);
 448     sub = Parrot_find_global_cur(interp, name);
 449     Parrot_call_sub(interp, sub, "v");
 450     Parrot_eprintf(interp, "back\\n");
 451
 452     /* win32 seems to buffer stderr ? */
 453     Parrot_io_flush(interp, Parrot_io_STDERR(interp));
 454
 455     name = Parrot_str_new_constant(interp, "_sub2");
 456     sub  = Parrot_find_global_cur(interp, name);
 457     arg  = pmc_new(interp, enum_class_String);
 458
 459     Parrot_PMC_set_string_native(interp, arg,
 460                  Parrot_str_new(interp, "hello ", 0));
 461
 462     Parrot_call_sub(interp, sub, "vP", arg);
 463     Parrot_eprintf(interp, "back\\n");
 464
 465     return NULL;
 466 }
 467 CODE
 468 in sub1
 469 back
 470 hello in sub2
 471 back
 472 OUTPUT
 473
 474 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub using the unified interface' );
 475
 476 #include <parrot/parrot.h>
 477 #include <parrot/embed.h>
 478 #include <parrot/extend.h>
 479
 480 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 481
 482 int
 483 main(int argc, char *argv[])
 484 {
 485     Parrot_Interp interp = Parrot_new(NULL);
 486     if (!interp)
 487         return 1;
 488
 489     Parrot_run_native(interp, the_test);
 490
 491     Parrot_exit(interp, 0);
 492     return 0;
 493 }
 494
 495 /* also both the test PASM and the_test() print to stderr
 496  * so that buffering in PIO is not an issue */
 497
 498 static opcode_t*
 499 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 500 {
 501     PackFile *pf = Parrot_pbc_read(interp, "$temp_pbc", 0);
 502     STRING   *name = Parrot_str_new_constant(interp, "_sub1");
 503     PMC      *sub, *arg;
 504
 505     Parrot_pbc_load(interp, pf);
 506     sub = Parrot_find_global_cur(interp, name);
 507     Parrot_ext_call(interp, sub, "->");
 508     Parrot_eprintf(interp, "back\\n");
 509
 510     /* win32 seems to buffer stderr ? */
 511     Parrot_io_flush(interp, Parrot_io_STDERR(interp));
 512
 513     name = Parrot_str_new_constant(interp, "_sub2");
 514     sub  = Parrot_find_global_cur(interp, name);
 515     arg  = pmc_new(interp, enum_class_String);
 516
 517     Parrot_PMC_set_string_native(interp, arg,
 518                  Parrot_str_new(interp, "hello ", 0));
 519
 520     Parrot_ext_call(interp, sub, "P->", arg);
 521     Parrot_eprintf(interp, "back\\n");
 522
 523     return NULL;
 524 }
 525 CODE
 526 in sub1
 527 back
 528 hello in sub2
 529 back
 530 OUTPUT
 531
 532 ($TEMP, my $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 533
 534 print $TEMP <<'EOF';
 535   .sub foo
 536       .param pmc input
 537       printerr input
 538       printerr "in sub2\n"
 539       $P0 = new "Integer"
 540       $P0 = 42
 541       .return($P0)
 542   .end
 543 EOF
 544 close $TEMP;
 545
 546 # compile to pbc
 547 (undef, $temp_pbc) = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
 548 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir);
 549
 550 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub and return an integer' );
 551
 552 #include <parrot/parrot.h>
 553 #include <parrot/embed.h>
 554 #include <parrot/extend.h>
 555
 556 static opcode_t *the_test(Parrot_Interp, opcode_t *, opcode_t *);
 557
 558 int
 559 main(int argc, char *argv[])
 560 {
 561     Parrot_Interp interp = Parrot_new(NULL);
 562     if (!interp)
 563         return 1;
 564
 565     Parrot_run_native(interp, the_test);
 566
 567     Parrot_exit(interp, 0);
 568     return 0;
 569 }
 570
 571 /* also both the test PASM and the_test() print to stderr
 572  * so that buffering in PIO is not an issue */
 573
 574 static opcode_t*
 575 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 576 {
 577     PackFile *pf = Parrot_pbc_read(interp, "$temp_pbc", 0);
 578     STRING   *name = Parrot_str_new_constant(interp, "foo");
 579     PMC      *sub, *arg;
 580     Parrot_Int result;
 581
 582     Parrot_pbc_load(interp, pf);
 583     sub  = Parrot_find_global_cur(interp, name);
 584     arg  = pmc_new(interp, enum_class_String);
 585
 586     Parrot_PMC_set_string_native(interp, arg,
 587                  Parrot_str_new(interp, "hello ", 0));
 588
 589     Parrot_ext_call(interp, sub, "P->I", arg, &result);
 590     Parrot_eprintf(interp, "result %d\\n", result);
 591     Parrot_eprintf(interp, "back\\n");
 592
 593     return NULL;
 594 }
 595 CODE
 596 hello in sub2
 597 result 42
 598 back
 599 OUTPUT
 600
 601 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 602
 603 print $TEMP <<'EOF';
 604   .pcc_sub _sub1:
 605   get_params ""
 606   printerr "in sub1\n"
 607   find_lex P2, "no_such_var"
 608   printerr "never\n"
 609   returncc
 610 EOF
 611 close $TEMP;
 612
 613 # compile to pbc
 614 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm);
 615
 616 c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub, catch exception' );
 617
 618 #include <parrot/parrot.h>
 619 #include <parrot/embed.h>
 620 #include <parrot/extend.h>
 621
 622 static opcode_t *
 623 the_test(Parrot_Interp, opcode_t *, opcode_t *);
 624
 625 int
 626 main(int argc, char *argv[])
 627 {
 628     Parrot_Interp interp = Parrot_new(NULL);
 629     if (!interp)
 630         return 1;
 631
 632     Parrot_run_native(interp, the_test);
 633
 634     Parrot_exit(interp, 0);
 635     return 0;
 636 }
 637
 638 /* also both the test PASM and the_test() print to stderr
 639  * so that buffering in PIO is not an issue */
 640
 641 static opcode_t*
 642 the_test(PARROT_INTERP, opcode_t *cur_op, opcode_t *start)
 643 {
 644     PackFile         *pf   = Parrot_pbc_read(interp, "$temp_pbc", 0);
 645     STRING           *name = Parrot_str_new_constant(interp, "_sub1");
 646     PMC              *sub;
 647     Parrot_runloop jump_point;
 648
 649     Parrot_pbc_load(interp, pf);
 650     sub = Parrot_find_global_cur(interp, name);
 651
 652     if (setjmp(jump_point.resume)) {
 653         Parrot_eprintf(interp, "caught\\n");
 654     }
 655     else {
 656         /* pretend the EH was pushed by the sub call. */
 657         interp->current_runloop_id++;
 658
 659         Parrot_ex_add_c_handler(interp, &jump_point);
 660         Parrot_call_sub(interp, sub, "v");
 661     }
 662
 663     Parrot_eprintf(interp, "back\\n");
 664
 665     return NULL;
 666 }
 667 CODE
 668 in sub1
 669 caught
 670 back
 671 OUTPUT
 672
 673 ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 674
 675 print $TEMP <<'EOF';
 676 .sub main :main
 677     .param pmc argv
 678
 679     .local pmc compiler
 680     compreg compiler, 'PIR'
 681
 682     .local string code
 683     code = argv[0]
 684
 685     .local pmc compiled_sub
 686     compiled_sub = compiler( code )
 687
 688     compiled_sub()
 689     end
 690 .end
 691
 692 .sub add :multi( int, int )
 693     .param int l
 694     .param int r
 695
 696     .local int sum
 697     sum = l + r
 698     .return( sum )
 699 .end
 700
 701 .sub add :multi( num, num )
 702     .param num l
 703     .param num r
 704
 705     .local num sum
 706     sum = l + r
 707     .return( sum )
 708 .end
 709 EOF
 710 close $TEMP;
 711
 712 # compile to pbc
 713 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir);
 714
 715 c_output_is( <<"CODE", <<'OUTPUT', 'eval code through a parrot sub - #39669' );
 716
 717 #include <parrot/parrot.h>
 718 #include <parrot/embed.h>
 719
 720 int
 721 main(int argc, char* argv[])
 722 {
 723     Parrot_PackFile packfile;
 724     char * code[] = { ".sub foo\\nsay \\"Hello from foo!\\"\\n.end\\n" };
 725
 726     Parrot_Interp interp = Parrot_new(NULL);
 727     if (!interp) {
 728         printf( "Hiss\\n" );
 729         return 1;
 730     }
 731
 732     packfile = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 733
 734     if (!packfile) {
 735         printf( "Boo\\n" );
 736         return 1;
 737     }
 738
 739     Parrot_pbc_load( interp, packfile );
 740     Parrot_runcode( interp, 1, code );
 741
 742     Parrot_destroy( interp );
 743
 744     Parrot_exit(interp, 0);
 745     return 0;
 746 }
 747 CODE
 748 Hello from foo!
 749 OUTPUT
 750
 751 c_output_is( <<'CODE', <<'OUTPUT', 'compile string in a fresh interp - #39986' );
 752
 753 #include <parrot/parrot.h>
 754 #include <parrot/embed.h>
 755 #include <parrot/extend.h>
 756
 757 int
 758 main(int argc, char* argv[])
 759 {
 760     Parrot_Interp   interp    = Parrot_new(NULL);
 761     const char      *code      = ".sub foo\nprint\"Hello from foo!\\n\"\n.end\n";
 762     Parrot_PMC      retval;
 763     Parrot_PMC      sub;
 764     STRING         *code_type;
 765     STRING         *error;
 766     STRING         *foo_name;
 767
 768     if (!interp) {
 769         printf( "Hiss\n" );
 770         return 1;
 771     }
 772
 773     code_type = Parrot_str_new_constant( interp, "PIR" );
 774     retval    = Parrot_compile_string( interp, code_type, code, &error );
 775
 776     if (!retval) {
 777         printf( "Boo\n" );
 778         return 1;
 779     }
 780
 781     foo_name = Parrot_str_new_constant( interp, "foo" );
 782     sub      = Parrot_find_global_cur( interp, foo_name );
 783
 784     retval   = (PMC *) Parrot_call_sub( interp, sub, "V", "" );
 785
 786     Parrot_exit(interp, 0);
 787     return 0;
 788 }
 789 CODE
 790 Hello from foo!
 791 OUTPUT
 792
 793 c_output_is( <<"CODE", <<'OUTPUT', 'call multi sub from C - #41511' );
 794 #include <parrot/parrot.h>
 795 #include <parrot/embed.h>
 796 #include <parrot/extend.h>
 797
 798 int
 799 main(int argc, char* argv[])
 800 {
 801     Parrot_Int      result;
 802     Parrot_PMC      sub;
 803     Parrot_PackFile pf;
 804     Parrot_Interp   interp = Parrot_new(NULL);
 805
 806     if (!interp) {
 807         printf( "No interpreter\\n" );
 808         return 1;
 809     }
 810
 811     pf = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 812     Parrot_pbc_load( interp, pf );
 813
 814     sub      = Parrot_find_global_cur( interp, Parrot_str_new_constant( interp, "add" ) );
 815     result   = Parrot_call_sub_ret_int( interp, sub, "III", 100, 200 );
 816     printf( "Result is %d.\\n", result );
 817
 818     Parrot_exit(interp, 0);
 819     return 0;
 820 }
 821 CODE
 822 Result is 300.
 823 OUTPUT
 824
 825 c_output_is( <<"CODE", <<'OUTPUT', 'call multi sub from C - unified interface' );
 826 #include <parrot/parrot.h>
 827 #include <parrot/embed.h>
 828 #include <parrot/extend.h>
 829
 830 int
 831 main(int argc, char* argv[])
 832 {
 833     Parrot_Int      result;
 834     Parrot_PMC      sub;
 835     Parrot_PackFile pf;
 836     Parrot_Interp   interp = Parrot_new(NULL);
 837
 838     if (!interp) {
 839         printf( "No interpreter\\n" );
 840         return 1;
 841     }
 842
 843     pf = Parrot_pbc_read( interp, "$temp_pbc", 0 );
 844     Parrot_pbc_load( interp, pf );
 845
 846     sub      = Parrot_find_global_cur( interp, Parrot_str_new_constant( interp, "add" ) );
 847     Parrot_ext_call( interp, sub, "II->I", 100, 200, &result );
 848     printf( "Result is %d.\\n", result );
 849
 850     Parrot_exit(interp, 0);
 851     return 0;
 852 }
 853 CODE
 854 Result is 300.
 855 OUTPUT
 856
 857 c_output_is( <<'CODE', <<'OUTPUT', 'multiple Parrot_new/Parrot_exit cycles' );
 858
 859 #include <stdio.h>
 860 #include "parrot/parrot.h"
 861 #include "parrot/embed.h"
 862
 863 /* this is Parrot_exit without the exit()
 864  * it will call Parrot_really_destroy() as an exit handler
 865  */
 866 void interp_cleanup(Parrot_Interp, int);
 867
 868 void interp_cleanup(PARROT_INTERP, int status)
 869 {
 870     handler_node_t *node = interp->exit_handler_list;
 871
 872     Parrot_block_GC_mark(interp);
 873     Parrot_block_GC_sweep(interp);
 874
 875     while (node) {
 876         handler_node_t * const next = node->next;
 877         (node->function)(interp, status, node->arg);
 878         mem_sys_free(node);
 879         node = next;
 880     }
 881 }
 882
 883 int
 884 main(int argc, char *argv[]) {
 885     Parrot_Interp interp;
 886     int i, niter = 2;
 887
 888     for (i = 1; i <= niter; i++) {
 889         printf("Starting interp %d\n", i);
 890         fflush(stdout);
 891         interp = Parrot_new(NULL);
 892         if (!interp)
 893             return 1;
 894
 895         Parrot_set_flag(interp, PARROT_DESTROY_FLAG);
 896
 897         printf("Destroying interp %d\n", i);
 898         fflush(stdout);
 899         interp_cleanup(interp, 0);
 900     }
 901
 902     return 0;
 903 }
 904
 905 CODE
 906 Starting interp 1
 907 Destroying interp 1
 908 Starting interp 2
 909 Destroying interp 2
 910 OUTPUT
 911
 912 # Local Variables:
 913 #   mode: cperl
 914 #   cperl-indent-level: 4
 915 #   fill-column: 100
 916 # End:
 917 # vim: expandtab shiftwidth=4: