t/pmc/eval.t

   1 #! perl
   2 # Copyright (C) 2001-2007, The Perl 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 tests => 17;
  10
  11 =head1 NAME
  12
  13 t/pmc/eval.t - Dynamic Code Evaluation
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/eval.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests on-the-fly PASM, PIR and PAST compilation and invocation.
  22
  23 =cut
  24
  25 pasm_output_is( <<'CODE', <<'OUTPUT', "eval_sc" );
  26     compreg P1, "PASM"  # get compiler
  27     set_args "0", "print \"in eval\\n\"\nset_returns \"()\"\nreturncc\n"
  28     get_results "0", P0
  29     invokecc P1                 # compile
  30     invokecc P0                 # eval code P0
  31     print "back again\n"
  32     end
  33 CODE
  34 in eval
  35 back again
  36 OUTPUT
  37
  38 pasm_output_is( <<'CODE', <<'OUTPUT', "call subs in evaled code " );
  39     set S5, ".pcc_sub _foo:\n"
  40     concat S5, "print \"foo\\n\"\n"
  41     concat S5, "set_returns \"()\"\n"
  42     concat S5, "returncc\n"
  43     compreg P1, "PASM"
  44     set_args "0", S5
  45     invokecc P1
  46     get_global P0, "_foo"
  47     invokecc P0
  48     print "back\n"
  49     end
  50 CODE
  51 foo
  52 back
  53 OUTPUT
  54
  55 pasm_output_is( <<'CODE', <<'OUTPUT', "call 2 subs in evaled code " );
  56     set S5, ".pcc_sub _foo:\n"
  57     concat S5, "print \"foo\\n\"\n"
  58     concat S5, "set_returns \"()\"\n"
  59     concat S5, "returncc\n"
  60     concat S5, ".pcc_sub _bar:\n"
  61     concat S5, "print \"bar\\n\"\n"
  62     concat S5, "set_returns \"()\"\n"
  63     concat S5, "returncc\n"
  64     compreg P1, "PASM"
  65     set_args "0", S5
  66     get_results "0", P6
  67     invokecc P1
  68     get_global P2, "_foo"
  69     invokecc P2
  70     print "back\n"
  71     get_global P2, "_bar"
  72     invokecc P2
  73     print "fin\n"
  74     end
  75 CODE
  76 foo
  77 back
  78 bar
  79 fin
  80 OUTPUT
  81
  82 pir_output_is( <<'CODE', <<'OUTPUT', "PIR compiler sub" );
  83
  84 .sub test :main
  85     .local pmc compiler
  86     get_global compiler, "xcompile"
  87     compreg "XPASM", compiler
  88     .local pmc my_compiler
  89     my_compiler = compreg "XPASM"
  90     .local pmc the_sub
  91     .local string code
  92     code = "print \"ok\\n\"\n"
  93     code .= "set_returns \"()\"\n"
  94     code .= "returncc\n"
  95     the_sub = my_compiler("_foo", code)
  96     the_sub()
  97     the_sub = global "_foo"
  98     the_sub()
  99 .end
 100
 101 .sub xcompile
 102     .param string sub_name
 103     .param string code
 104     $S0 = ".pcc_sub "
 105     $S0 .= sub_name
 106     $S0 .= ":\n"
 107     $S0 .= code
 108     .local pmc pasm_compiler
 109     pasm_compiler = compreg "PASM"
 110     # print $S0
 111     $P0 = pasm_compiler($S0)
 112     .return($P0)
 113 .end
 114 CODE
 115 ok
 116 ok
 117 OUTPUT
 118
 119 pir_output_is( <<'CODE', <<'OUTPUT', "bug #31467" );
 120
 121   .sub main :main
 122      $P1 = new 'Hash'
 123      $P0 = find_name "_builtin"
 124      $P1['builtin'] = $P0
 125
 126      $P2 = compreg "PIR"
 127      $S0 = ".sub main\nprint \"dynamic\\n\"\n.end\n"
 128      $P0 = $P2($S0)
 129      $P1['dynamic'] = $P0
 130
 131      set_global "funcs", $P1
 132
 133      $S0 = ".sub main\n$P1 = get_global\"funcs\"\n"
 134      $S0 .= "$P0 = $P1['dynamic']\n$P0()\n"
 135      $S0 .= "$P0 = $P1['builtin']\n$P0()\n"
 136      $S0 .= ".end\n"
 137
 138      $P2 = compreg "PIR"
 139      $P0 = $P2($S0)
 140      $P0()
 141      end
 142   .end
 143
 144   .sub _builtin
 145       print "builtin\n"
 146   .end
 147 CODE
 148 dynamic
 149 builtin
 150 OUTPUT
 151
 152 pir_output_is( <<'CODE', <<'OUTPUT', "PIR compiler sub PASM" );
 153 .sub main :main
 154   register_compiler()
 155
 156   .local pmc compiler, invokable
 157   compiler = compreg "PUTS"
 158
 159   invokable = compiler("ok 1")
 160   invokable()
 161
 162 .end
 163
 164 .sub register_compiler
 165   $P0 = get_global "puts"
 166   compreg "PUTS", $P0
 167 .end
 168
 169 .sub puts
 170   .param string printme
 171
 172   .local pmc pasm_compiler, retval
 173   pasm_compiler = compreg "PASM"
 174
 175   .local string code
 176
 177   code = "print \""
 178   code .= printme
 179   code .= "\\n\"\n"
 180   code .= "set_returns \"()\"\n"
 181   code .= "returncc\n"
 182
 183   retval = pasm_compiler( code )
 184
 185   .return (retval)
 186 .end
 187 CODE
 188 ok 1
 189 OUTPUT
 190
 191 pir_output_is( <<'CODE', <<'OUTPUT', "PIR compiler sub PIR" );
 192 .sub main :main
 193   register_compiler()
 194
 195   .local pmc compiler, invokable
 196   compiler = compreg "PUTS"
 197
 198   invokable = compiler( "ok 1" )
 199   invokable()
 200
 201 .end
 202
 203 .sub register_compiler
 204  .local pmc counter
 205  counter = new 'Integer'
 206  counter = 0
 207  set_global "counter", counter
 208
 209   $P0 = get_global "_puts"
 210   compreg "PUTS", $P0
 211 .end
 212
 213 .sub _puts
 214   .param string printme
 215
 216   .local pmc pir_compiler, retval
 217   pir_compiler = compreg "PIR"
 218
 219   .local pmc counter
 220   counter = get_global "counter"
 221   inc counter
 222
 223   .local string code
 224   code = ".sub anonymous"
 225   $S0 = counter
 226   code .= $S0
 227   code .= " :anon\n"
 228   code .= "print \""
 229   code .= printme
 230   code .= "\\n\"\n"
 231   code .=".end\n"
 232
 233   retval = pir_compiler( code )
 234
 235   .return (retval)
 236 .end
 237 CODE
 238 ok 1
 239 OUTPUT
 240
 241 pir_output_is( <<'CODE', <<'OUTPUT', "eval.get_string" );
 242 .sub main :main
 243
 244   .local pmc f1, f2
 245   .local pmc io
 246   f1 = compi("foo_1", "hello from foo_1")
 247   $S0 = f1
 248   io = open "temp.pbc", ">"
 249   print io, $S0
 250   close io
 251   load_bytecode "temp.pbc"
 252   f2 = compi("foo_2", "hello from foo_2")
 253   io = open "temp2.pbc", ">"
 254   print io, f2
 255   close io
 256   load_bytecode "temp2.pbc"
 257 .end
 258
 259 .sub compi
 260   .param string name
 261   .param string printme
 262   .local string code
 263   .local pmc pir_compiler, retval
 264   pir_compiler = compreg "PIR"
 265   code = ".sub "
 266   code .= name
 267   code .= " :load\n"
 268   code .= "print \""
 269   code .= printme
 270   code .= "\\n\"\n"
 271   code .= ".end\n"
 272
 273   retval = pir_compiler(code)
 274   .return (retval)
 275 .end
 276 CODE
 277 hello from foo_1
 278 hello from foo_2
 279 OUTPUT
 280
 281 pir_output_is( <<'CODE', <<'OUTPUT', "check loaded lib hash" );
 282 .sub main
 283   load_bytecode "temp.pbc"
 284   load_bytecode "temp2.pbc"
 285   .local pmc pbc_hash, interp
 286   .include 'iglobals.pasm'
 287   interp = getinterp
 288   pbc_hash = interp[.IGLOBALS_PBC_LIBS]
 289   $I0 = elements pbc_hash
 290   print $I0
 291   print ' '
 292   $I1 = exists pbc_hash['temp']
 293   print $I1
 294   print ' '
 295   $I2 = exists pbc_hash['temp2']
 296   print $I2
 297   print ' '
 298   $S0 = pbc_hash['temp2']
 299   # print $S0          not portable
 300   $I3 = index $S0, 'temp2.pbc'
 301   $I4 = isgt $I3, -1
 302   say $I4
 303 .end
 304 CODE
 305 hello from foo_1
 306 hello from foo_2
 307 2 1 1 1
 308 OUTPUT
 309
 310 pir_output_is( <<'CODE', <<'OUTPUT', "eval.get_string - same file" );
 311 .sub main :main
 312
 313   .local pmc f1, f2
 314   .local pmc io, os
 315   f1 = compi("foo_1", "hello from foo_1")
 316   $S0 = f1
 317   io = open "temp.pbc", ">"
 318   print io, $S0
 319   close io
 320   load_bytecode "temp.pbc"
 321   os = new 'OS'
 322   os.rm("temp.pbc")
 323   f2 = compi("foo_2", "hello from foo_2")
 324   io = open "temp.pbc", ">"
 325   print io, f2
 326   close io
 327   load_bytecode "temp.pbc"
 328 .end
 329
 330 .sub compi
 331   .param string name
 332   .param string printme
 333   .local string code
 334   .local pmc pir_compiler, retval
 335   pir_compiler = compreg "PIR"
 336   code = ".sub "
 337   code .= name
 338   code .= " :load\n"
 339   code .= "print \""
 340   code .= printme
 341   code .= "\\n\"\n"
 342   code .= ".end\n"
 343
 344   retval = pir_compiler(code)
 345   .return (retval)
 346 .end
 347 CODE
 348 hello from foo_1
 349 OUTPUT
 350
 351 END {
 352     unlink "temp.pbc", "temp2.pbc", "temp.file";
 353 }
 354
 355 pir_output_is( <<'CODE', <<'OUTPUT', "eval.freeze" );
 356 .sub main :main
 357   .local pmc f, e
 358   .local pmc io
 359   f = compi("foo_1", "hello from foo_1")
 360   $S0 = freeze f
 361   io = open "temp.file", ">"
 362   print io, $S0
 363   close io
 364   print "written\n"
 365 .end
 366
 367 .sub compi
 368   .param string name
 369   .param string printme
 370   .local string code
 371   .local pmc pir_compiler, retval
 372   pir_compiler = compreg "PIR"
 373   code = ".sub "
 374   code .= name
 375   code .= "\n"
 376   code .= "print \""
 377   code .= printme
 378   code .= "\\n\"\n"
 379   code .= ".end\n"
 380
 381   retval = pir_compiler(code)
 382   .return (retval)
 383 .end
 384 CODE
 385 written
 386 OUTPUT
 387
 388 pir_output_is( <<'CODE', <<'OUTPUT', "eval.thaw" );
 389 .sub main :main
 390     .local pmc io, e
 391     .local string file
 392     .local int size
 393     file = "temp.file"
 394     .include "stat.pasm"
 395     size = stat file, .STAT_FILESIZE
 396     io = open file, "<"
 397     $S0 = read io, size
 398     close io
 399     e = thaw $S0
 400     e()
 401     e = get_global "foo_1"
 402     e()
 403 .end
 404 CODE
 405 hello from foo_1
 406 hello from foo_1
 407 OUTPUT
 408
 409 pir_output_is( <<'CODE', <<'OUTPUT', "eval.freeze+thaw" );
 410 .sub main :main
 411   .local pmc f, e
 412   .local pmc io
 413   f = compi("foo_1", "hello from foo_1")
 414   $S0 = freeze f
 415   io = open "temp.file", ">"
 416   print io, $S0
 417   close io
 418   print "written\n"
 419   "read"()
 420 .end
 421
 422 .sub compi
 423   .param string name
 424   .param string printme
 425   .local string code
 426   .local pmc pir_compiler, retval
 427   pir_compiler = compreg "PIR"
 428   code = ".sub "
 429   code .= name
 430   code .= "\n"
 431   code .= <<"MORE"
 432   noop
 433   noop
 434   noop
 435   noop
 436 MORE
 437   code .= "print \""
 438   code .= printme
 439   code .= "\\n\"\n"
 440   code .= ".end\n"
 441
 442   retval = pir_compiler(code)
 443   .return (retval)
 444 .end
 445
 446 .sub "read"
 447     .local pmc io, e
 448     .local string file
 449     .local int size
 450     file = "temp.file"
 451     .include "stat.pasm"
 452     size = stat file, .STAT_FILESIZE
 453     io = open file, "<"
 454     $S0 = read io, size
 455     close io
 456     e = thaw $S0
 457     e()
 458     e = get_global "foo_1"
 459     e()
 460 .end
 461 CODE
 462 written
 463 hello from foo_1
 464 hello from foo_1
 465 OUTPUT
 466
 467 pir_output_is( <<'CODE', <<'OUTPUT', "get_pmc_keyed_int" );
 468 .sub main :main
 469     .local string code
 470     .local pmc e, s, compi
 471     code = <<"EOC"
 472     .sub foo
 473         noop
 474     .end
 475     .sub bar
 476         noop
 477     .end
 478 EOC
 479     compi = compreg "PIR"
 480     e  = compi(code)
 481     s = e[0]
 482     print s
 483     print "\n"
 484     s = e[1]
 485     print s
 486     print "\n"
 487 .end
 488 CODE
 489 foo
 490 bar
 491 OUTPUT
 492
 493 pir_output_is( <<'CODE', <<'OUTPUT', "catch compile err: RT:#39892" );
 494 .sub main :main
 495      push_eh handler
 496      $P2 = compreg "PIR"
 497      $S0 = <<"EPIR"
 498   .sub foo
 499      print a typo
 500   .end
 501 EPIR
 502      $P0 = $P2($S0)
 503      $P0()
 504      end
 505 handler:
 506      print "ok\n"
 507 .end
 508 CODE
 509 ok
 510 OUTPUT
 511
 512 open my $TEMP, '>', "temp.pir" or die "can't open 'temp.pir': $!";
 513 END { unlink "temp.pir" }
 514 print $TEMP <<PIR;
 515   .sub foo
 516      print a typo
 517   .end
 518 PIR
 519 close $TEMP;
 520
 521 pir_error_output_like( <<'CODE', <<'OUTPUT', "compile err in load_bytecode" );
 522 .sub main :main
 523      load_bytecode "temp.pir"
 524      print "never\n"
 525      end
 526 .end
 527 CODE
 528 /undefined identifier/
 529 OUTPUT
 530
 531 pir_output_is( <<'CODE', <<'OUTPUT', "catch compile err in load_bytecode" );
 532 .sub main :main
 533      push_eh handler
 534      load_bytecode "temp.pir"
 535      print "never\n"
 536      end
 537 handler:
 538      print "ok\n"
 539 .end
 540 CODE
 541 ok
 542 OUTPUT
 543
 544 # Local Variables:
 545 #   mode: cperl
 546 #   cperl-indent-level: 4
 547 #   fill-column: 100
 548 # End:
 549 # vim: expandtab shiftwidth=4: