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 pir_output_is( <<'CODE', <<'OUTPUT', "exit_handler via exit exception" );
 427 .sub main :main
 428     .local pmc a
 429     .lex 'a', a
 430     a = new 'Integer'
 431     a = 42
 432     push_eh handler
 433     exit 0
 434 handler:
 435     .const 'Sub' $P0 = 'exit_handler'
 436     capture_lex $P0
 437     .tailcall $P0()
 438 .end
 439
 440 .sub exit_handler :outer(main)
 441     say "at_exit"
 442     .local pmc a
 443     a = find_lex 'a'
 444     print 'a = '
 445     say a
 446 .end
 447 CODE
 448 at_exit
 449 a = 42
 450 OUTPUT
 451
 452 ## Regression test for r14697.  This probably won't be needed when PDD23 is
 453 ## fully implemented.
 454 pir_error_output_like( <<'CODE', <<'OUTPUT', "invoke handler in calling sub" );
 455 ## This tests that error handlers are out of scope when invoked (necessary for
 456 ## rethrow) when the error is signalled in another sub.
 457 .sub main :main
 458     push_eh handler
 459     broken()
 460     print "not reached.\n"
 461 handler:
 462     .local pmc exception
 463     .get_results (exception)
 464     $S0 = exception
 465     print "in handler.\n"
 466     print $S0
 467     print "\n"
 468     rethrow exception
 469 .end
 470
 471 .sub broken
 472     $P0 = new 'Exception'
 473     $P0 = "something broke"
 474     throw $P0
 475 .end
 476 CODE
 477 /\Ain handler.
 478 something broke
 479 something broke
 480 current inst/
 481 OUTPUT
 482
 483 pir_error_output_like( <<'CODE', <<'OUTPUT', 'die_s' );
 484 .sub main :main
 485     die 'We are dying str!'
 486 .end
 487 CODE
 488 /We are dying str!/
 489 OUTPUT
 490 pir_error_output_like( <<'CODE', <<'OUTPUT', 'die_p' );
 491 .sub main :main
 492     .local pmc msg
 493     msg = new 'String'
 494     msg = 'We are dying pmc!'
 495     die msg
 496 .end
 497 CODE
 498 /We are dying pmc!/
 499 OUTPUT
 500
 501 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - goto label" );
 502 .sub main :main
 503     print "before calling setup_foo\n"
 504     setup_foo()
 505     print "after calling setup_foo\n"
 506     end
 507 .end
 508
 509 .sub setup_foo
 510     print "in setup_foo\n"
 511     newclass $P0, "Foo"
 512     push_eh handler
 513     newclass $P0, "Foo"
 514     pop_eh
 515 resume:
 516     print "running more code\n"
 517     .return()
 518 handler:
 519     print "in handler\n"
 520     goto resume
 521 .end
 522
 523 CODE
 524 before calling setup_foo
 525 in setup_foo
 526 in handler
 527 running more code
 528 after calling setup_foo
 529 OUTPUT
 530
 531 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - return from cont" );
 532 .sub main :main
 533     print "before calling setup_foo\n"
 534     setup_foo()
 535     print "after calling setup_foo\n"
 536     end
 537 .end
 538
 539 .sub setup_foo
 540     print "in setup_foo\n"
 541     newclass $P0, "Foo"
 542     push_eh handler
 543     newclass $P0, "Foo"
 544     pop_eh
 545 resume:
 546     print "never reached\n"
 547 handler:
 548     print "in handler\n"
 549     .return()
 550 .end
 551 CODE
 552 before calling setup_foo
 553 in setup_foo
 554 in handler
 555 after calling setup_foo
 556 OUTPUT
 557
 558
 559 pir_output_is( <<'CODE', <<'OUTPUT', "resuming after exception handled - return from cont" );
 560 # This test is a simplified version of PGE's grammar creation code.
 561
 562 .sub main :main
 563     $P1 = newclass 'FirstClass'
 564     $P1 = newclass 'MakerClass'
 565
 566     $P0 = new 'String'
 567     $P0 = 'Foo'
 568     $P1 = newclass $P0
 569
 570     print "before compile\n"
 571     compile($P0)
 572     print "after compile\n"
 573     end
 574 .end
 575
 576 .sub compile
 577     .param string classname
 578     print "in compile subroutine\n"
 579     $P0 = new 'FirstClass'
 580     $P1 = $P0.'compile'(classname)
 581     print "returned from handler\nException message: "
 582     print $P1
 583 .end
 584
 585 .namespace [ "FirstClass" ]
 586 .sub 'compile' :method
 587     .param pmc name
 588     print "in compile method\n"
 589     $P1 = new 'String'
 590     $P1 = "no exception\n"
 591   make_grammar:
 592     push_eh handler
 593     $P0 = new 'MakerClass'
 594     $P0.'make'(name)
 595     pop_eh
 596     .return($P1)
 597   handler:
 598     get_results "0", $P2
 599     print "in handler\n"
 600   .return ($P2)
 601 .end
 602
 603 .namespace [ "MakerClass" ]
 604 .sub 'make' :method
 605     .param pmc name
 606     print "in make method\n"
 607     $P0 = newclass name
 608     print "after newclass, never reached\n"
 609 .end
 610
 611 CODE
 612 before compile
 613 in compile subroutine
 614 in compile method
 615 in make method
 616 in handler
 617 returned from handler
 618 Exception message: Class Foo already registered!
 619 after compile
 620 OUTPUT
 621
 622 pir_output_is( <<'CODE', <<'OUTPUT', "Resumable exceptions" );
 623 .sub main :main
 624     push_eh _handler
 625     new $P1, 'Exception'
 626     say 'Before throwing'
 627     throw $P1
 628     say 'After throwing'
 629     end
 630 _handler:
 631     .local pmc e
 632     .local string s
 633     .local pmc c
 634     .get_results (e)
 635     s = e
 636     say 'In the exception handler'
 637     c = e['resume']
 638     c()
 639 .end
 640 CODE
 641 Before throwing
 642 In the exception handler
 643 After throwing
 644 OUTPUT
 645
 646 pir_output_is( <<'CODE', <<'OUTPUT', "Resumable exceptions from a different context");
 647 .sub main :main
 648     push_eh catcher
 649     'foo'()
 650     pop_eh
 651     say 'ok 4'
 652     .return ()
 653   catcher:
 654     .get_results ($P0)
 655     $P1 = $P0['resume']
 656     say 'in the handler'
 657     $P1()
 658 .end
 659
 660 .sub 'foo'
 661     say 'ok 1'
 662     $P0 = new 'Exception'
 663     throw $P0
 664     say 'ok 2'
 665     $P0 = new 'Exception'
 666     throw $P0
 667     say 'ok 3'
 668 .end
 669 CODE
 670 ok 1
 671 in the handler
 672 ok 2
 673 in the handler
 674 ok 3
 675 ok 4
 676 OUTPUT
 677 # Local Variables:
 678 #   mode: cperl
 679 #   cperl-indent-level: 4
 680 #   fill-column: 100
 681 # End:
 682 # vim: expandtab shiftwidth=4: