t/src/embed.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 use Test::More;
   9 use Parrot::Test;
  10
  11 plan tests => 10;
  12
  13 =head1 NAME
  14
  15 t/src/embed.t - Embedding parrot
  16
  17 =head1 SYNOPSIS
  18
  19     % prove t/src/embed.t
  20
  21 =head1 DESCRIPTION
  22
  23 Embedding parrot in C
  24
  25 =cut
  26
  27 sub linedirective
  28 {
  29     # Provide a #line directive for the C code in the heredoc
  30     # starting immediately after where this sub is called.
  31     my $linenum = shift() + 1;
  32     return "#line " . $linenum . ' "' . __FILE__ . '"' . "\n";
  33 }
  34
  35 c_output_is(linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Minimal embed, using just the embed.h header" );
  36
  37 #include <stdio.h>
  38 #include <stdlib.h>
  39
  40 #include "parrot/embed.h"
  41
  42 void fail(const char *msg);
  43
  44 void fail(const char *msg)
  45 {
  46     fprintf(stderr, "failed: %s\n", msg);
  47     exit(EXIT_FAILURE);
  48 }
  49
  50 int main(int argc, const char **argv)
  51 {
  52     Parrot_Interp interp;
  53     interp = Parrot_new(NULL);
  54     if (! interp)
  55         fail("Cannot create parrot interpreter");
  56
  57     puts("Done");
  58     Parrot_destroy(interp);
  59     return 0;
  60 }
  61 CODE
  62 Done
  63 OUTPUT
  64
  65 my $common = linedirective(__LINE__) . <<'CODE';
  66 #include <stdio.h>
  67 #include <stdlib.h>
  68 #include <string.h>
  69 #include "parrot/embed.h"
  70 #include "parrot/extend.h"
  71
  72 static void fail(const char *msg);
  73 static Parrot_String createstring(Parrot_Interp interp, const char * value);
  74
  75 static void fail(const char *msg)
  76 {
  77     fprintf(stderr, "failed: %s\n", msg);
  78     exit(EXIT_FAILURE);
  79 }
  80
  81 static Parrot_String createstring(Parrot_Interp interp, const char * value)
  82 {
  83     return Parrot_new_string(interp, value, strlen(value), (const char*)NULL, 0);
  84 }
  85
  86 CODE
  87
  88 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when an opcode is given improper arguments');
  89
  90 int main(int argc, const char **argv)
  91 {
  92     Parrot_Interp interp;
  93     Parrot_String err, lang;
  94     Parrot_PMC func_pmc;
  95     char *str;
  96
  97     interp = Parrot_new(NULL);
  98     if (! interp)
  99         fail("Cannot create parrot interpreter");
 100     lang = createstring(interp, "PIR");
 101
 102     func_pmc = Parrot_compile_string(interp, lang, ".sub foo\n copy\n.end", &err);
 103     Parrot_printf(interp, "%Ss\n", err);
 104     Parrot_destroy(interp);
 105     return 0;
 106 }
 107 CODE
 108 The opcode 'copy' (copy<0>) was not found. Check the type and number of the arguments
 109 OUTPUT
 110
 111 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when given invalid language string');
 112
 113 int main(int argc, const char **argv)
 114 {
 115     Parrot_Interp interp;
 116     Parrot_String err, lang;
 117     Parrot_PMC func_pmc;
 118     char *str;
 119
 120     interp = Parrot_new(NULL);
 121     if (! interp)
 122         fail("Cannot create parrot interpreter");
 123     lang = createstring(interp, "Foo");
 124
 125     func_pmc = Parrot_compile_string(interp, lang, "This doesn't matter", &err);
 126     Parrot_printf(interp, "%Ss\n", err);
 127     Parrot_destroy(interp);
 128     return 0;
 129 }
 130 CODE
 131 Invalid interpreter type
 132 OUTPUT
 133
 134
 135 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', 'Parrot_compile_string populates the error string when there is an IMCC syntax error', 'todo' => 'TT #1610 : does not properly catch IMCC errors');
 136
 137 int main(int argc, const char **argv)
 138 {
 139     Parrot_Interp interp;
 140     Parrot_String err, lang;
 141     Parrot_PMC func_pmc;
 142     char *str;
 143
 144     interp = Parrot_new(NULL);
 145     if (! interp)
 146         fail("Cannot create parrot interpreter");
 147     lang = createstring(interp, "PIR");
 148
 149     func_pmc = Parrot_compile_string(interp, lang, "The sleeper must awake", &err);
 150     Parrot_printf(interp,"Caught exception\n");
 151     Parrot_printf(interp, "%Ss\n", err);
 152     Parrot_destroy(interp);
 153     return 0;
 154 }
 155 CODE
 156 Caught exception
 157 error:imcc:syntax error, unexpected IDENTIFIER ('The')
 158 OUTPUT
 159
 160
 161 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from main" );
 162
 163 int main(void)
 164 {
 165     Parrot_Interp interp;
 166     Parrot_String compiler;
 167     Parrot_String errstr;
 168     Parrot_PMC code;
 169
 170     /* Create the interpreter and show a message using parrot io */
 171     interp = Parrot_new(NULL);
 172     if (! interp)
 173         fail("Cannot create parrot interpreter");
 174     Parrot_printf(interp, "Hello, parrot\n");
 175
 176     /* Compile and execute a pir sub */
 177     compiler = createstring(interp, "PIR");
 178     code = Parrot_compile_string(interp, compiler,
 179 ".sub main :main\n"
 180 "  say 'Hello, pir'\n"
 181 "\n"
 182 ".end\n"
 183 "\n",
 184         &errstr
 185     );
 186     Parrot_ext_call(interp, code, "->");
 187
 188     Parrot_destroy(interp);
 189     return 0;
 190 }
 191 CODE
 192 Hello, parrot
 193 Hello, pir
 194 OUTPUT
 195
 196 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Hello world from a sub" );
 197
 198 int main(void)
 199 {
 200     Parrot_Interp interp;
 201     Parrot_String compiler;
 202     Parrot_String errstr;
 203     Parrot_PMC code;
 204     Parrot_PMC rootns;
 205     Parrot_String parrotname;
 206     Parrot_PMC parrotns;
 207     Parrot_String subname;
 208     Parrot_PMC sub;
 209
 210     /* Create the interpreter */
 211     interp = Parrot_new(NULL);
 212     if (! interp)
 213         fail("Cannot create parrot interpreter");
 214
 215     /* Compile pir code */
 216     compiler = createstring(interp, "PIR");
 217     code = Parrot_compile_string(interp, compiler,
 218 ".sub main :main\n"
 219 "  say 'Must not be seen!'\n"
 220 "\n"
 221 ".end\n"
 222 "\n"
 223 ".sub hello\n"
 224 "  say 'Hello, sub'\n"
 225 "\n"
 226 ".end\n"
 227 "\n",
 228         &errstr
 229     );
 230
 231     /* Get parrot namespace */
 232     rootns = Parrot_get_root_namespace(interp);
 233     parrotname = createstring(interp, "parrot");
 234     parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns,  parrotname);
 235     /* Get the sub */
 236     subname = createstring(interp, "hello");
 237     sub = Parrot_PMC_get_pmc_keyed_str(interp, parrotns,  subname);
 238     /* Execute it */
 239     Parrot_ext_call(interp, sub, "->");
 240
 241     Parrot_destroy(interp);
 242     return 0;
 243 }
 244 CODE
 245 Hello, sub
 246 OUTPUT
 247
 248 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "calling a sub with argument and return" );
 249
 250 int main(void)
 251 {
 252     Parrot_Interp interp;
 253     Parrot_String compiler;
 254     Parrot_String errstr;
 255     Parrot_PMC code;
 256     Parrot_PMC rootns;
 257     Parrot_String parrotname;
 258     Parrot_PMC parrotns;
 259     Parrot_String subname;
 260     Parrot_PMC sub;
 261     Parrot_String msg;
 262     Parrot_String retstr;
 263
 264     /* Create the interpreter */
 265     interp = Parrot_new(NULL);
 266     if (! interp)
 267         fail("Cannot create parrot interpreter");
 268
 269     /* Compile pir code */
 270     compiler = createstring(interp, "PIR");
 271     code = Parrot_compile_string(interp, compiler,
 272 ".sub main :main\n"
 273 "  say 'Must not be seen!'\n"
 274 "\n"
 275 ".end\n"
 276 "\n"
 277 ".sub hello\n"
 278 "  .param string s\n"
 279 "  print s\n"
 280 "  .return('world!')\n"
 281 "\n"
 282 ".end\n"
 283 "\n",
 284         &errstr
 285     );
 286
 287     /* Get parrot namespace */
 288     rootns = Parrot_get_root_namespace(interp);
 289     parrotname = createstring(interp, "parrot");
 290     parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns,  parrotname);
 291     /* Get the sub */
 292     subname = createstring(interp, "hello");
 293     sub = Parrot_PMC_get_pmc_keyed_str(interp, parrotns,  subname);
 294
 295     /* Execute it */
 296     msg = createstring(interp, "Hello, ");
 297     Parrot_ext_call(interp, sub, "S->S", msg, &retstr);
 298     Parrot_printf(interp, "%Ss\n", retstr);
 299
 300     Parrot_destroy(interp);
 301     return 0;
 302 }
 303 CODE
 304 Hello, world!
 305 OUTPUT
 306
 307 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "External sub" );
 308
 309 void hello(Parrot_Interp interp);
 310
 311 void hello(Parrot_Interp interp)
 312 {
 313     Parrot_printf(interp, "Hello from C\n");
 314 }
 315
 316 int main(void)
 317 {
 318     Parrot_Interp interp;
 319     Parrot_String compiler;
 320     Parrot_String errstr;
 321     Parrot_PMC code;
 322     Parrot_PMC hellosub;
 323
 324     /* Create the interpreter */
 325     interp = Parrot_new(NULL);
 326     if (! interp)
 327         fail("Cannot create parrot interpreter");
 328
 329     /* Compile pir */
 330     compiler = createstring(interp, "PIR");
 331     code = Parrot_compile_string(interp, compiler,
 332 ".sub externcall\n"
 333 "  .param pmc ec\n"
 334 "  ec()\n"
 335 "\n"
 336 ".end\n"
 337 "\n",
 338         &errstr
 339     );
 340     hellosub = Parrot_sub_new_from_c_func(interp, (void (*)())& hello, "vJ");
 341     Parrot_ext_call(interp, code, "P->", hellosub);
 342
 343     Parrot_destroy(interp);
 344     return 0;
 345 }
 346 CODE
 347 Hello from C
 348 OUTPUT
 349
 350 c_output_is($common . linedirective(__LINE__) . <<'CODE', <<'OUTPUT', "Insert external sub in namespace" );
 351
 352 void hello(Parrot_Interp interp);
 353
 354 void hello(Parrot_Interp interp)
 355 {
 356     Parrot_printf(interp, "Hello from C\n");
 357 }
 358
 359 int main(void)
 360 {
 361     Parrot_Interp interp;
 362     Parrot_String compiler;
 363     Parrot_String errstr;
 364     Parrot_PMC code;
 365     Parrot_PMC hellosub;
 366     Parrot_PMC rootns;
 367     Parrot_String parrotname;
 368     Parrot_PMC parrotns;
 369     Parrot_String helloname;
 370     void *discard;
 371
 372     /* Create the interpreter */
 373     interp = Parrot_new(NULL);
 374     if (! interp)
 375         fail("Cannot create parrot interpreter");
 376
 377     /* Compile pir */
 378     compiler = createstring(interp, "PIR");
 379     code = Parrot_compile_string(interp, compiler,
 380 ".sub externcall\n"
 381 "  hello()\n"
 382 "\n"
 383 ".end\n"
 384 "\n",
 385         &errstr
 386     );
 387
 388     /* Create extern sub and insert in parrot namespace */
 389     rootns = Parrot_get_root_namespace(interp);
 390     parrotname = createstring(interp, "parrot");
 391     parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
 392     hellosub = Parrot_sub_new_from_c_func(interp, (void (*)())& hello, "vJ");
 393     helloname = createstring(interp, "hello");
 394     Parrot_PMC_set_pmc_keyed_str(interp, parrotns, helloname, hellosub);
 395
 396     /* Call it */
 397     Parrot_ext_call(interp, code, "->");
 398
 399     Parrot_destroy(interp);
 400     return 0;
 401 }
 402 CODE
 403 Hello from C
 404 OUTPUT
 405
 406 # Old tests, skipped al
 407
 408 SKIP: {
 409
 410     skip('TT #306; many symbols not exported, embedding parrot fails', 1);
 411
 412 ########################################################################
 413
 414 c_output_is( <<'CODE', <<'OUTPUT', "Parrot Compile API Single call" );
 415
 416 #include <stdio.h>
 417 #include "parrot/embed.h"
 418
 419 static opcode_t *
 420 run(PARROT_INTERP, int argc, cosnt char *argv[])
 421 {
 422     const char *c_src = ".sub main :main\n" "    print \"ok\\n\"\n" ".end\n";
 423
 424     Parrot_String *src, *smain;
 425     PMC *prog, *entry;
 426     opcode_t *dest;
 427     Parrot_String *error;
 428
 429     /* get PIR compiler  - TODO API */
 430     PMC   *compreg = Parrot_PMC_get_pmc_keyed_int(interp,
 431                                        interp->iglobals,
 432                                        IGLOBALS_COMPREG_HASH);
 433     Parrot_String *pir    = Parrot_str_new_constant(interp, "PIR");
 434     PMC    *comp   = Parrot_PMC_get_pmc_keyed_str(interp, compreg, pir);
 435
 436     if (PMC_IS_NULL(comp) || !Parrot_PMC_defined(interp, comp)) {
 437         Parrot_io_eprintf(interp, "Pir compiler not loaded");
 438         exit(EXIT_FAILURE);
 439     }
 440
 441     /* compile source */
 442     prog = Parrot_compile_string(interp, pir, c_src, &error);
 443
 444     if (PMC_IS_NULL(prog) || !Parrot_PMC_defined(interp, prog)) {
 445         Parrot_io_eprintf(interp, "Pir compiler returned no prog");
 446         exit(EXIT_FAILURE);
 447     }
 448
 449     /* keep eval PMC alive */
 450     gc_register_pmc(interp, prog);
 451
 452     /* locate function to run */
 453     smain = Parrot_str_new_constant(interp, "main");
 454     entry = Parrot_ns_find_current_namespace_global(interp, smain);
 455
 456     /* location of the entry */
 457     interp->current_cont = new_ret_continuation_pmc(interp, NULL);
 458     dest                 = Parrot_PMC_invoke(interp, entry, NULL);
 459
 460     /* where to start */
 461     interp->resume_offset = dest -interp->code->base.data;
 462
 463     /* and go */
 464     Parrot_runcode(interp, argc, (char **)argv);
 465     return NULL;
 466 }
 467
 468 int
 469 main(int margc, const char *margv[])
 470 {
 471     Parrot_Interp interp;
 472     PackFile *pf;
 473     int argc = 1;
 474     const char *argv[] = { "test", NULL };
 475
 476     PackFile_Segment *seg;
 477
 478     /* Interpreter set-up */
 479     interp = Parrot_new(NULL);
 480     if (interp == NULL)
 481         return 1;
 482
 483     /* dummy pf and segment to get things started */
 484     pf = PackFile_new_dummy(interp, "test_code");
 485
 486     /* Parrot_set_flag(interp, PARROT_TRACE_FLAG); */
 487     run(interp, argc, (char **)argv);
 488     Parrot_exit(interp, 0);
 489     return 0;
 490 }
 491 CODE
 492 ok
 493 OUTPUT
 494 c_output_is( <<'CODE', <<'OUTPUT', "Parrot Compile API Multiple Calls" );
 495
 496 #include <stdio.h>
 497 #include "parrot/embed.h"
 498
 499 static void
 500 compile_run(PARROT_INTERP, const char *src, Parrot_String *type, int argc,
 501             const char *argv[])
 502 {
 503     Parrot_String   *smain;
 504     PMC      *entry;
 505     Parrot_String   *error;
 506     opcode_t *dest;
 507     PMC      *prog = Parrot_compile_string(interp, type, src, &error);
 508
 509     if (PMC_IS_NULL(prog) || !Parrot_PMC_defined(interp, prog)) {
 510         Parrot_io_eprintf(interp, "Pir compiler returned no prog");
 511         exit(EXIT_FAILURE);
 512     }
 513
 514     /* keep eval PMC alive */
 515     gc_register_pmc(interp, prog);
 516
 517     /* locate function to run */
 518     smain = Parrot_str_new_constant(interp, "main");
 519     entry = Parrot_ns_find_current_namespace_global(interp, smain);
 520
 521     /* location of the entry */
 522     interp->current_cont = new_ret_continuation_pmc(interp, NULL);
 523     dest                 = Parrot_PMC_invoke(interp, entry, NULL);
 524
 525     /* where to start */
 526     interp->resume_offset = dest -interp->code->base.data;
 527
 528     /* and go */
 529     Parrot_runcode(interp, argc, (char **)argv);
 530 }
 531
 532 static opcode_t *
 533 run(PARROT_INTERP, int argc, const char *argv[])
 534 {
 535     const char *c_src  = ".sub main :main\n" "    print \"ok\\n\"\n" ".end\n";
 536
 537     const char *c2_src =
 538         ".sub main :main\n" "    print \"hola\\n\"\n" ".end\n";
 539
 540     Parrot_String *src, *smain;
 541
 542     /* get PIR compiler  - TODO API */
 543     PMC    *compreg = Parrot_PMC_get_pmc_keyed_int(interp,
 544                                        interp->iglobals,
 545                                        IGLOBALS_COMPREG_HASH);
 546     Parrot_String *pir     = Parrot_str_new_constant(interp, "PIR");
 547     PMC    *comp    = Parrot_PMC_get_pmc_keyed_str(interp, compreg, pir);
 548
 549     if (PMC_IS_NULL(comp) || !Parrot_PMC_defined(interp, comp)) {
 550         Parrot_io_eprintf(interp, "Pir compiler not loaded");
 551         exit(EXIT_FAILURE);
 552     }
 553
 554     compile_run(interp, c_src, pir, argc, argv);
 555     compile_run(interp, c2_src, pir, argc, argv);
 556 }
 557
 558 int
 559 main(int margc, const char *margv[])
 560 {
 561     Parrot_Interp interp;
 562     PackFile *pf;
 563     int argc = 1;
 564     const char *argv[] = { "test", NULL };
 565
 566     PackFile_Segment *seg;
 567
 568     /* Interpreter set-up */
 569     interp = Parrot_new(NULL);
 570     if (interp == NULL)
 571         return 1;
 572
 573     /* dummy pf and segment to get things started */
 574     pf = PackFile_new_dummy(interp, "test_code");
 575
 576     /* Parrot_set_flag(interp, PARROT_TRACE_FLAG); */
 577     run(interp, argc, (char **) argv);
 578     Parrot_exit(interp, 0);
 579     return 0;
 580 }
 581 CODE
 582 ok
 583 hola
 584 OUTPUT
 585 c_output_is( <<'CODE', <<'OUTPUT', "Parrot Compile API Multiple 1st bad PIR" );
 586
 587 #include <stdio.h>
 588 #include "parrot/embed.h"
 589
 590 static void
 591 compile_run(PARROT_INTERP, const char *src, Parrot_String *type, int argc,
 592             const char *argv[])
 593 {
 594     Parrot_String   *smain;
 595     PMC      *entry;
 596     Parrot_String   *error;
 597     opcode_t *dest;
 598     PMC      *prog = Parrot_compile_string(interp, type, src, &error);
 599
 600     if (PMC_IS_NULL(prog) || !Parrot_PMC_defined(interp, prog)) {
 601         Parrot_io_eprintf(interp, "Pir compiler returned no prog\n");
 602         return;
 603     }
 604
 605     /* keep eval PMC alive */
 606     gc_register_pmc(interp, prog);
 607
 608     /* locate function to run */
 609     smain = Parrot_str_new_constant(interp, "main");
 610     entry = Parrot_ns_find_current_namespace_global(interp, smain);
 611
 612     /* location of the entry */
 613     interp->current_cont = new_ret_continuation_pmc(interp, NULL);
 614     dest                 = Parrot_PMC_invoke(interp, entry, NULL);
 615
 616     /* where to start */
 617     interp->resume_offset = dest -interp->code->base.data;
 618
 619     /* and go */
 620     Parrot_runcode(interp, argc, (char **) argv);
 621 }
 622
 623 static opcode_t *
 624 run(PARROT_INTERP, int argc, const char *argv[])
 625 {
 626     const char *c_src  = ".sub main :main\n" "    print ok\\n\"\n" ".end\n";
 627
 628     const char *c2_src =
 629         ".sub main :main\n" "    print \"hola\\n\"\n" ".end\n";
 630
 631     Parrot_String *src, *smain;
 632
 633     /* get PIR compiler  - TODO API */
 634     PMC    *compreg = Parrot_PMC_get_pmc_keyed_int(interp,
 635                                        interp->iglobals,
 636                                        IGLOBALS_COMPREG_HASH);
 637     Parrot_String *pir     = Parrot_str_new_constant(interp, "PIR");
 638     PMC    *comp    = Parrot_PMC_get_pmc_keyed_str(interp, compreg, pir);
 639
 640     if (PMC_IS_NULL(comp) || !Parrot_PMC_defined(interp, comp)) {
 641         Parrot_io_eprintf(interp, "Pir compiler not loaded");
 642         return NULL;
 643     }
 644
 645     compile_run(interp, c_src, pir, argc, argv);
 646     compile_run(interp, c2_src, pir, argc, argv);
 647 }
 648
 649 int
 650 main(int margc, const char *margv[])
 651 {
 652     Parrot_Interp interp;
 653     PackFile *pf;
 654     int argc = 1;
 655     const char *argv[] = { "test", NULL };
 656
 657     PackFile_Segment *seg;
 658
 659     /* Interpreter set-up */
 660     interp = Parrot_new(NULL);
 661     if (interp == NULL)
 662         return 1;
 663
 664     /* dummy pf and segment to get things started */
 665     pf = PackFile_new_dummy(interp, "test_code");
 666
 667     /* Parrot_set_flag(interp, PARROT_TRACE_FLAG); */
 668     run(interp, argc, argv);
 669     Parrot_exit(interp, 0);
 670     return 0;
 671 }
 672 CODE
 673 Pir compiler returned no prog
 674 hola
 675 OUTPUT
 676 c_output_is( <<'CODE', <<'OUTPUT', "Parrot Compile API Multiple 2nd bad PIR" );
 677
 678 #include <stdio.h>
 679 #include "parrot/embed.h"
 680
 681 static void
 682 compile_run(PARROT_INTERP, const char *src, Parrot_String *type, int argc,
 683             const char *argv[])
 684 {
 685     Parrot_String   *smain;
 686     PMC      *entry;
 687     Parrot_String   *error;
 688     opcode_t *dest;
 689     PMC      *prog = Parrot_compile_string(interp, type, src, &error);
 690
 691     if (PMC_IS_NULL(prog) || !Parrot_PMC_defined(interp, prog)) {
 692         Parrot_io_eprintf(interp, "Pir compiler returned no prog\n");
 693         return;
 694     }
 695
 696     /* keep eval PMC alive */
 697     gc_register_pmc(interp, prog);
 698
 699     /* locate function to run */
 700     smain = Parrot_str_new_constant(interp, "main");
 701     entry = Parrot_ns_find_current_namespace_global(interp, smain);
 702
 703     /* location of the entry */
 704     interp->current_cont = new_ret_continuation_pmc(interp, NULL);
 705     dest                 = Parrot_PMC_invoke(interp, entry, NULL);
 706
 707     /* where to start */
 708     interp->resume_offset = dest -interp->code->base.data;
 709
 710     /* and go */
 711     Parrot_runcode(interp, argc, (char **)argv);
 712 }
 713
 714 static opcode_t *
 715 run(PARROT_INTERP, int argc, const char *argv[])
 716 {
 717     const char *c_src  = ".sub main :main\n" "    print ok\\n\"\n" ".end\n";
 718
 719     const char *c2_src =
 720         ".sub main :main\n" "    print \"hola\\n\"\n" ".end\n";
 721
 722     Parrot_String *src, *smain;
 723     /* get PIR compiler  - TODO API */
 724     PMC    *compreg = Parrot_PMC_get_pmc_keyed_int(interp,
 725                                        interp->iglobals,
 726                                        IGLOBALS_COMPREG_HASH);
 727     Parrot_String *pir     = Parrot_str_new_constant(interp, "PIR");
 728     PMC    *comp    = Parrot_PMC_get_pmc_keyed_str(interp, compreg, pir);
 729
 730     if (PMC_IS_NULL(comp) || !Parrot_PMC_defined(interp, comp)) {
 731         Parrot_io_eprintf(interp, "Pir compiler not loaded");
 732         return NULL;
 733     }
 734
 735     compile_run(interp, c2_src, pir, argc, argv);
 736     compile_run(interp, c_src, pir, argc, argv);
 737 }
 738
 739 int
 740 main(int margc, const char *margv[])
 741 {
 742     Parrot_Interp interp;
 743     PackFile *pf;
 744     int argc = 1;
 745     char *argv[] = { "test", NULL };
 746
 747     PackFile_Segment *seg;
 748
 749     /* Interpreter set-up */
 750     interp = Parrot_new(NULL);
 751     if (interp == NULL)
 752         return 1;
 753
 754     /* dummy pf and segment to get things started */
 755     pf = PackFile_new_dummy(interp, "test_code");
 756
 757     /* Parrot_set_flag(interp, PARROT_TRACE_FLAG); */
 758     run(interp, argc, argv);
 759     Parrot_exit(interp, 0);
 760     return 0;
 761 }
 762 CODE
 763 hola
 764 Pir compiler returned no prog
 765 OUTPUT
 766 c_output_is( <<'CODE', <<'OUTPUT', "Parrot Compile API Multiple bad PIR" );
 767
 768 #include <stdio.h>
 769 #include "parrot/embed.h"
 770
 771 static void
 772 compile_run(PARROT_INTERP, const char *src, Parrot_String *type, int argc,
 773             const char *argv[])
 774 {
 775     Parrot_String   *smain;
 776     PMC      *entry;
 777     Parrot_String   *error;
 778     opcode_t *dest;
 779     PMC      *prog = Parrot_compile_string(interp, type, src, &error);
 780
 781     if (PMC_IS_NULL(prog) || !Parrot_PMC_defined(interp, prog)) {
 782         Parrot_io_eprintf(interp, "Pir compiler returned no prog\n");
 783         return;
 784     }
 785
 786     /* keep eval PMC alive */
 787     gc_register_pmc(interp, prog);
 788
 789     /* locate function to run */
 790     smain = Parrot_str_new_constant(interp, "main");
 791     entry = Parrot_ns_find_current_namespace_global(interp, smain);
 792
 793     /* location of the entry */
 794     interp->current_cont = new_ret_continuation_pmc(interp, NULL);
 795     dest                 = Parrot_PMC_invoke(interp, entry, NULL);
 796
 797     /* where to start */
 798     interp->resume_offset = dest -interp->code->base.data;
 799
 800     /* and go */
 801     Parrot_runcode(interp, argc, (char **)argv);
 802 }
 803
 804 static opcode_t *
 805 run(PARROT_INTERP, int argc, const char *argv[])
 806 {
 807     const char *c_src  = ".sub main :main\n" "    print ok\\n\"\n" ".end\n";
 808
 809     const char *c2_src = ".sub main :main\n" "    print hola\\n\"\n" ".end\n";
 810
 811     Parrot_String *src, *smain;
 812     /* get PIR compiler  - TODO API */
 813     PMC    *compreg = Parrot_PMC_get_pmc_keyed_int(interp,
 814                                        interp->iglobals,
 815                                        IGLOBALS_COMPREG_HASH);
 816     Parrot_String *pir     = Parrot_str_new_constant(interp, "PIR");
 817     PMC    *comp    = Parrot_PMC_get_pmc_keyed_str(interp, compreg, pir);
 818
 819     if (PMC_IS_NULL(comp) || !Parrot_PMC_defined(interp, comp)) {
 820         Parrot_io_eprintf(interp, "Pir compiler not loaded");
 821         return NULL;
 822     }
 823
 824     compile_run(interp, c_src, pir, argc, argv);
 825     compile_run(interp, c2_src, pir, argc, argv);
 826 }
 827
 828 int
 829 main(int margc, const char *margv[])
 830 {
 831     Parrot_Interp interp;
 832     PackFile *pf;
 833     int argc = 1;
 834     char *argv[] = { "test", NULL };
 835
 836     PackFile_Segment *seg;
 837
 838     /* Interpreter set-up */
 839     interp = Parrot_new(NULL);
 840     if (interp == NULL)
 841         return 1;
 842
 843     /* dummy pf and segment to get things started */
 844     pf = PackFile_new_dummy(interp, "test_code");
 845
 846     /* Parrot_set_flag(interp, PARROT_TRACE_FLAG); */
 847     run(interp, argc, argv);
 848     Parrot_exit(interp, 0);
 849     return 0;
 850 }
 851 CODE
 852 Pir compiler returned no prog
 853 Pir compiler returned no prog
 854 OUTPUT
 855
 856 }
 857
 858 # Local Variables:
 859 #   mode: cperl
 860 #   cperl-indent-level: 4
 861 #   fill-column: 100
 862 # End:
 863 # vim: expandtab shiftwidth=4: