t/op/exceptions.t

   1 #! perl
   2 # Copyright (C) 2001-2008, 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 tests => 31;
  10
  11 =head1 NAME
  12
  13 t/op/exceptions.t - Exception Handling
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/op/exceptions.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests C<Exception> and C<ExceptionHandler> PMCs.
  22
  23 =cut
  24
  25 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh label - pop_eh" );
  26     push_eh _handler
  27     print "ok 1\n"
  28     pop_eh
  29     print "ok 2\n"
  30     end
  31 _handler:
  32     end
  33 CODE
  34 ok 1
  35 ok 2
  36 OUTPUT
  37
  38 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh eh - pop_eh" );
  39     new P29, 'ExceptionHandler'
  40     push_eh P29
  41     print "ok 1\n"
  42     pop_eh
  43     print "ok 2\n"
  44     end
  45 CODE
  46 ok 1
  47 ok 2
  48 OUTPUT
  49
  50 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
  51     print "main\n"
  52     push_eh _handler
  53     new P30, 'Exception'
  54     throw P30
  55     print "not reached\n"
  56     end
  57 _handler:
  58     print "caught it\n"
  59     end
  60 CODE
  61 main
  62 caught it
  63 OUTPUT
  64
  65 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh eh - throw" );
  66     print "main\n"
  67     new P29, 'ExceptionHandler'
  68     set_addr P29, _handler
  69     push_eh P29
  70     new P30, 'Exception'
  71     throw P30
  72     print "not reached\n"
  73     end
  74 _handler:
  75     print "caught it\n"
  76     end
  77 CODE
  78 main
  79 caught it
  80 OUTPUT
  81
  82 pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
  83     print "main\n"
  84     push_eh handler
  85     new P1, 'Exception'
  86     set P1, "just pining"
  87     throw P1
  88     print "not reached\n"
  89     end
  90 handler:
  91     get_results "0", P0
  92     set S0, P0
  93     print "caught it\n"
  94     typeof S1, P0
  95     print S1
  96     print "\n"
  97     print S0
  98     print "\n"
  99     null P5
 100     end
 101
 102 CODE
 103 main
 104 caught it
 105 Exception
 106 just pining
 107 OUTPUT
 108
 109 pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
 110 # see also #38459
 111     print "main\n"
 112     new P0, 'Integer'
 113     push_eh handler
 114     new P1, 'Exception'
 115     set P1, "just pining"
 116     throw P1
 117     print "not reached\n"
 118     end
 119 handler:
 120     get_results "0", P1
 121     inc P0
 122     print "ok\n"
 123     end
 124
 125 CODE
 126 main
 127 ok
 128 OUTPUT
 129
 130 pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
 131 .sub main :main
 132     print "main\n"
 133     push_eh _handler
 134     new $P1, 'Exception'
 135     set $P1, "just pining"
 136     throw $P1
 137     print "not reached\n"
 138     end
 139 _handler:
 140     .local pmc e
 141     .local string s
 142     .get_results (e)
 143     s = e
 144     print "caught it\n"
 145     typeof $S1, e
 146     print $S1
 147     print "\n"
 148     print s
 149     print "\n"
 150     null $P5
 151 .end
 152 CODE
 153 main
 154 caught it
 155 Exception
 156 just pining
 157 OUTPUT
 158
 159 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw - message" );
 160     print "main\n"
 161     push_eh _handler
 162
 163     new P30, 'Exception'
 164     set P30, "something happend"
 165     throw P30
 166     print "not reached\n"
 167     end
 168 _handler:
 169     get_results "0", P5
 170     set S0, P5
 171     print "caught it\n"
 172     print S0
 173     print "\n"
 174     end
 175 CODE
 176 main
 177 caught it
 178 something happend
 179 OUTPUT
 180
 181 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
 182     new P0, 'Exception'
 183     set P0, "something happend"
 184     throw P0
 185     print "not reached\n"
 186     end
 187 CODE
 188 /something happend/
 189 OUTPUT
 190
 191 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
 192     push_eh _handler
 193     new P0, 'Exception'
 194     pop_eh
 195     throw P0
 196     print "not reached\n"
 197     end
 198 _handler:
 199     end
 200 CODE
 201 /No exception handler and no message/
 202 OUTPUT
 203
 204 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
 205     new P0, 'Exception'
 206     throw P0
 207     print "not reached\n"
 208     end
 209 CODE
 210 /No exception handler and no message/
 211 OUTPUT
 212
 213 pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers" );
 214     print "main\n"
 215     push_eh _handler1
 216     push_eh _handler2
 217
 218     new P30, 'Exception'
 219     set P30, "something happend"
 220     throw P30
 221     print "not reached\n"
 222     end
 223 _handler1:
 224     get_results "0", P5
 225     set S0, P5
 226     print "caught it in 1\n"
 227     print S0
 228     print "\n"
 229     end
 230 _handler2:
 231     get_results "0", P0
 232     set S0, P0
 233     print "caught it in 2\n"
 234     print S0
 235     print "\n"
 236     end
 237 CODE
 238 main
 239 caught it in 2
 240 something happend
 241 OUTPUT
 242
 243 pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers, throw next" );
 244     print "main\n"
 245     push_eh _handler1
 246     push_eh _handler2
 247
 248     new P30, 'Exception'
 249     set P30, "something happend"
 250     throw P30
 251     print "not reached\n"
 252     end
 253 _handler1:
 254     get_results "0", P5
 255     set S0, P5
 256     print "caught it in 1\n"
 257     print S0
 258     print "\n"
 259     end
 260 _handler2:
 261     get_results "0", P5
 262     set S0, P5
 263     print "caught it in 2\n"
 264     print S0
 265     print "\n"
 266     rethrow P5
 267     end
 268 CODE
 269 main
 270 caught it in 2
 271 something happend
 272 caught it in 1
 273 something happend
 274 OUTPUT
 275
 276 pasm_output_is( <<'CODE', <<OUT, "die" );
 277     push_eh _handler
 278     die 3, 100
 279     print "not reached\n"
 280     end
 281 _handler:
 282     print "caught it\n"
 283     end
 284 CODE
 285 caught it
 286 OUT
 287
 288 pasm_output_is( <<'CODE', <<OUT, "die, error, severity" );
 289     push_eh _handler
 290     die 3, 100
 291     print "not reached\n"
 292     end
 293 _handler:
 294     get_results "0", P5
 295     print "caught it\n"
 296     set I0, P5['severity']
 297     print "severity "
 298     print I0
 299     print "\n"
 300     end
 301 CODE
 302 caught it
 303 severity 3
 304 OUT
 305
 306 pasm_error_output_like( <<'CODE', <<OUT, "die - no handler" );
 307     die 3, 100
 308     print "not reached\n"
 309     end
 310 _handler:
 311     print "caught it\n"
 312     end
 313 CODE
 314 /No exception handler and no message/
 315 OUT
 316
 317 pasm_output_is( <<'CODE', '', "exit exception" );
 318     noop
 319     exit 0
 320     print "not reached\n"
 321     end
 322 CODE
 323
 324 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
 325     print "main\n"
 326     push_eh handler
 327     print "ok\n"
 328     new P30, 'Exception'
 329     throw P30
 330     print "not reached\n"
 331     end
 332 handler:
 333     print "caught it\n"
 334     end
 335 CODE
 336 main
 337 ok
 338 caught it
 339 OUTPUT
 340 1;
 341
 342 pir_error_output_like( <<'CODE', <<'OUTPUT', 'pop_eh with no handler' );
 343 .sub main :main
 344     pop_eh
 345     print "no exceptions.\n"
 346 .end
 347 CODE
 348 /No handler to delete./
 349 OUTPUT
 350
 351 pir_output_is( <<'CODE', <<'OUTPUT', 'pop_eh out of context (2)');
 352 .sub main :main
 353     .local pmc outer, cont
 354     push_eh handler
 355     test1()
 356     print "skipped.\n"
 357     goto done
 358 handler:
 359     .local pmc exception
 360     .get_results (exception)
 361     $S0 = exception
 362     print "Error: "
 363     print $S0
 364     print "\n"
 365 done:
 366     print "done.\n"
 367 .end
 368 .sub test1
 369     .local pmc exit
 370     print "[in test1]\n"
 371     ## pop_eh is illegal here, and signals an exception.
 372     pop_eh
 373     print "[cleared]\n"
 374 .end
 375 CODE
 376 [in test1]
 377 Error: No handler to delete.
 378 done.
 379 OUTPUT
 380
 381 # stringification is handled by a vtable, which runs in a second
 382 # runloop. when an error in the method tries to go to a Error_Handler defined
 383 # outside it, it winds up going to the inner runloop, giving strange results.
 384 pir_output_is( <<'CODE', <<'OUTPUT', 'pop_eh out of context (2)', todo => 'runloop shenanigans' );
 385 .sub main :main
 386         $P0 = get_hll_global ['Foo'], 'load'
 387         $P0()
 388         $P0 = new 'Foo'
 389         push_eh catch
 390         $S0 = $P0
 391         pop_eh
 392         say "huh?"
 393         .return()
 394
 395 catch:
 396         say "caught"
 397         .return()
 398 .end
 399
 400 .namespace ['Foo']
 401
 402 .sub load
 403     $P0 = newclass 'Foo'
 404 .end
 405
 406 .sub get_string :vtable :method
 407     $P0 = new 'Exception'
 408     throw $P0
 409 .end
 410 CODE
 411 caught
 412 OUTPUT
 413
 414 pir_error_output_like( <<'CODE', <<'OUTPUT', "throw in main, no handler" );
 415 .sub main :main
 416     print "main\n"
 417     $P0 = new 'Exception'
 418     throw $P0
 419     .return()
 420 .end
 421 CODE
 422 /^main
 423 No exception handler/
 424 OUTPUT
 425
 426 $ENV{TEST_PROG_ARGS} ||= '';
 427 my @todo = $ENV{TEST_PROG_ARGS} =~ /--run-pbc/
 428     ? ( todo => '.tailcall and lexical maps not thawed from PBC, TT #1172' )
 429     : ();
 430 #
 431 # this test is hanging in testr since pcc_hackathon_6Mar10 branch merge at r45108
 432 # converting to skip at the moment
 433 #
 434
 435 SKIP: {
 436     skip ".tailcall and lexical maps not thawed from PBC - hangs", 1 if @todo;
 437
 438 pir_output_is( <<'CODE', <<'OUTPUT', "exit_handler via exit exception", @todo );
 439 .sub main :main
 440     .local pmc a
 441     .lex 'a', a
 442     a = new 'Integer'
 443     a = 42
 444     push_eh handler
 445     exit 0
 446 handler:
 447     .tailcall exit_handler()
 448 .end
 449
 450 .sub exit_handler :outer(main)
 451     say "at_exit"
 452     .local pmc a
 453     a = find_lex 'a'
 454     print 'a = '
 455     say a
 456 .end
 457 CODE
 458 at_exit
 459 a = 42
 460 OUTPUT
 461
 462 }
 463
 464 ## Regression test for r14697.  This probably won't be needed when PDD23 is
 465 ## fully implemented.
 466 pir_error_output_like( <<'CODE', <<'OUTPUT', "invoke handler in calling sub" );
 467 ## This tests that error handlers are out of scope when invoked (necessary for
 468 ## rethrow) when the error is signalled in another sub.
 469 .sub main :main
 470     push_eh handler
 471     broken()
 472     print "not reached.\n"
 473 handler:
 474     .local pmc exception
 475     .get_results (exception)
 476     $S0 = exception
 477     print "in handler.\n"
 478     print $S0
 479     print "\n"
 480     rethrow exception
 481 .end
 482
 483 .sub broken
 484     $P0 = new 'Exception'
 485     $P0 = "something broke"
 486     throw $P0
 487 .end
 488 CODE
 489 /\Ain handler.
 490 something broke
 491 something broke
 492 current inst/
 493 OUTPUT
 494
 495 pir_error_output_like( <<'CODE', <<'OUTPUT', 'die_s' );
 496 .sub main :main
 497     die 'We are dying str!'
 498 .end
 499 CODE
 500 /We are dying str!/
 501 OUTPUT
 502 pir_error_output_like( <<'CODE', <<'OUTPUT', 'die_p' );
 503 .sub main :main
 504     .local pmc msg
 505     msg = new 'String'
 506     msg = 'We are dying pmc!'
 507     die msg
 508 .end
 509 CODE
 510 /We are dying pmc!/
 511 OUTPUT
 512
 513 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - goto label" );
 514 .sub main :main
 515     print "before calling setup_foo\n"
 516     setup_foo()
 517     print "after calling setup_foo\n"
 518     end
 519 .end
 520
 521 .sub setup_foo
 522     print "in setup_foo\n"
 523     newclass $P0, "Foo"
 524     push_eh handler
 525     newclass $P0, "Foo"
 526     pop_eh
 527 resume:
 528     print "running more code\n"
 529     .return()
 530 handler:
 531     print "in handler\n"
 532     goto resume
 533 .end
 534
 535 CODE
 536 before calling setup_foo
 537 in setup_foo
 538 in handler
 539 running more code
 540 after calling setup_foo
 541 OUTPUT
 542
 543 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - return from cont" );
 544 .sub main :main
 545     print "before calling setup_foo\n"
 546     setup_foo()
 547     print "after calling setup_foo\n"
 548     end
 549 .end
 550
 551 .sub setup_foo
 552     print "in setup_foo\n"
 553     newclass $P0, "Foo"
 554     push_eh handler
 555     newclass $P0, "Foo"
 556     pop_eh
 557 resume:
 558     print "never reached\n"
 559 handler:
 560     print "in handler\n"
 561     .return()
 562 .end
 563 CODE
 564 before calling setup_foo
 565 in setup_foo
 566 in handler
 567 after calling setup_foo
 568 OUTPUT
 569
 570
 571 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - return from cont" );
 572 # This test is a simplified version of PGE's grammar creation code.
 573
 574 .sub main :main
 575     $P1 = newclass 'FirstClass'
 576     $P1 = newclass 'MakerClass'
 577
 578     $P0 = new 'String'
 579     $P0 = 'Foo'
 580     $P1 = newclass $P0
 581
 582     print "before compile\n"
 583     compile($P0)
 584     print "after compile\n"
 585     end
 586 .end
 587
 588 .sub compile
 589     .param string classname
 590     print "in compile subroutine\n"
 591     $P0 = new 'FirstClass'
 592     $P1 = $P0.'compile'(classname)
 593     print "returned from handler\nException message: "
 594     print $P1
 595 .end
 596
 597 .namespace [ "FirstClass" ]
 598 .sub 'compile' :method
 599     .param pmc name
 600     print "in compile method\n"
 601     $P1 = new 'String'
 602     $P1 = "no exception\n"
 603   make_grammar:
 604     push_eh handler
 605     $P0 = new 'MakerClass'
 606     $P0.'make'(name)
 607     pop_eh
 608     .return($P1)
 609   handler:
 610     get_results "0", $P2
 611     print "in handler\n"
 612   .return ($P2)
 613 .end
 614
 615 .namespace [ "MakerClass" ]
 616 .sub 'make' :method
 617     .param pmc name
 618     print "in make method\n"
 619     $P0 = newclass name
 620     print "after newclass, never reached\n"
 621 .end
 622
 623 CODE
 624 before compile
 625 in compile subroutine
 626 in compile method
 627 in make method
 628 in handler
 629 returned from handler
 630 Exception message: Class Foo already registered!
 631 after compile
 632 OUTPUT
 633
 634 pir_output_is( <<'CODE', <<'OUTPUT', "Resumable exceptions" );
 635 .sub main :main
 636     push_eh _handler
 637     new $P1, 'Exception'
 638     say 'Before throwing'
 639     throw $P1
 640     say 'After throwing'
 641     end
 642 _handler:
 643     .local pmc e
 644     .local string s
 645     .local pmc c
 646     .get_results (e)
 647     s = e
 648     say 'In the exception handler'
 649     c = e['resume']
 650     c()
 651 .end
 652 CODE
 653 Before throwing
 654 In the exception handler
 655 After throwing
 656 OUTPUT
 657
 658 pir_output_is( <<'CODE', <<'OUTPUT', "Resumable exceptions from a different context");
 659 .sub main :main
 660     push_eh catcher
 661     'foo'()
 662     pop_eh
 663     say 'ok 4'
 664     .return ()
 665   catcher:
 666     .get_results ($P0)
 667     $P1 = $P0['resume']
 668     say 'in the handler'
 669     $P1()
 670 .end
 671
 672 .sub 'foo'
 673     say 'ok 1'
 674     $P0 = new 'Exception'
 675     throw $P0
 676     say 'ok 2'
 677     $P0 = new 'Exception'
 678     throw $P0
 679     say 'ok 3'
 680 .end
 681 CODE
 682 ok 1
 683 in the handler
 684 ok 2
 685 in the handler
 686 ok 3
 687 ok 4
 688 OUTPUT
 689 # Local Variables:
 690 #   mode: cperl
 691 #   cperl-indent-level: 4
 692 #   fill-column: 100
 693 # End:
 694 # vim: expandtab shiftwidth=4: