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