t/pmc/exception-old.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 => 22;
  10
  11 =head1 NAME
  12
  13 t/pmc/exception.t - Exception Handling
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/exception-old.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests C<Exception> and C<ExceptionHandler> PMCs.
  22
  23 =cut
  24
  25
  26 pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
  27     print "main\n"
  28     push_eh handler
  29     new P1, ['Exception']
  30     new P2, ['String']
  31     set P2, "just pining"
  32     setattribute P1, 'message', P2
  33     throw P1
  34     print "not reached\n"
  35     end
  36 handler:
  37     get_results "0", P0
  38     set S0, P0
  39     print "caught it\n"
  40     typeof S1, P0
  41     print S1
  42     print "\n"
  43     print S0
  44     print "\n"
  45     null P5
  46     end
  47
  48 CODE
  49 main
  50 caught it
  51 Exception
  52 just pining
  53 OUTPUT
  54
  55 pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with String' );
  56 .sub main :main
  57   .local pmc ex, exr
  58   .local pmc msg, msgr
  59   msg = new ['String']
  60   msg = 'Message'
  61   ex = new ['Exception'], msg
  62   push_eh handler
  63   throw ex
  64   say 'Never here'
  65 handler:
  66   .get_results(exr)
  67   msgr = exr['message']
  68   say msgr
  69 .end
  70 CODE
  71 Message
  72 OUTPUT
  73
  74 pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with Hash' );
  75 .sub main :main
  76   .local pmc ex, exr
  77   .local pmc h, msgr
  78   h = new ['Hash']
  79   h['message'] = 'Message'
  80   ex = new ['Exception'], h
  81   push_eh handler
  82   throw ex
  83   say 'Never here'
  84 handler:
  85   .get_results(exr)
  86   msgr = exr['message']
  87   say msgr
  88 .end
  89 CODE
  90 Message
  91 OUTPUT
  92
  93 pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
  94 # see also #38459
  95     print "main\n"
  96     new P0, ['Integer']
  97     push_eh handler
  98     new P1, ['Exception']
  99     new P2, ['String']
 100     set P2, "just pining"
 101     setattribute P1, 'message', P2
 102     throw P1
 103     print "not reached\n"
 104     end
 105 handler:
 106     get_results "0", P1
 107     inc P0
 108     print "ok\n"
 109     end
 110
 111 CODE
 112 main
 113 ok
 114 OUTPUT
 115
 116 pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
 117 .sub main :main
 118     print "main\n"
 119     push_eh _handler
 120     $P1 = new ['Exception']
 121     $P2 = new ['String']
 122     set $P2, "just pining"
 123     setattribute $P1, 'message', $P2
 124     throw $P1
 125     print "not reached\n"
 126     end
 127 _handler:
 128     .local pmc e
 129     .local string s
 130     .get_results (e)
 131     s = e
 132     print "caught it\n"
 133     typeof $S1, e
 134     print $S1
 135     print "\n"
 136     print s
 137     print "\n"
 138     null $P5
 139 .end
 140 CODE
 141 main
 142 caught it
 143 Exception
 144 just pining
 145 OUTPUT
 146
 147 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw - message" );
 148     print "main\n"
 149     push_eh _handler
 150
 151     new P30, ['Exception']
 152     new P20, ['String']
 153     set P20, "something happened"
 154     setattribute P30, "message", P20
 155     throw P30
 156     print "not reached\n"
 157     end
 158 _handler:
 159     get_results "0", P5
 160     set S0, P5
 161     print "caught it\n"
 162     print S0
 163     print "\n"
 164     end
 165 CODE
 166 main
 167 caught it
 168 something happened
 169 OUTPUT
 170
 171 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
 172     new P0, ['Exception']
 173     new P20, ['String']
 174     set P20, "something happened"
 175     setattribute P0, "message", P20
 176     throw P0
 177     print "not reached\n"
 178     end
 179 CODE
 180 /something happened/
 181 OUTPUT
 182
 183 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
 184     push_eh _handler
 185     new P0, ['Exception']
 186     pop_eh
 187     throw P0
 188     print "not reached\n"
 189     end
 190 _handler:
 191     end
 192 CODE
 193 /No exception handler and no message/
 194 OUTPUT
 195
 196 pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
 197     new P0, ['Exception']
 198     throw P0
 199     print "not reached\n"
 200     end
 201 CODE
 202 /No exception handler and no message/
 203 OUTPUT
 204
 205 pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers" );
 206     print "main\n"
 207     push_eh _handler1
 208     push_eh _handler2
 209
 210     new P30, ['Exception']
 211     new P20, ['String']
 212     set P20, "something happened"
 213     setattribute P30, "message", P20
 214     throw P30
 215     print "not reached\n"
 216     end
 217 _handler1:
 218     get_results "0", P5
 219     getattribute P2, P5, "message"
 220     print "caught it in 1\n"
 221     print P2
 222     print "\n"
 223     end
 224 _handler2:
 225     get_results "0", P0
 226     getattribute P2, P0, "message"
 227     print "caught it in 2\n"
 228     print P2
 229     print "\n"
 230     end
 231 CODE
 232 main
 233 caught it in 2
 234 something happened
 235 OUTPUT
 236
 237 pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers, throw next" );
 238     print "main\n"
 239     push_eh _handler1
 240     push_eh _handler2
 241
 242     new P30, ['Exception']
 243     new P20, ['String']
 244     set P20, "something happened"
 245     setattribute P30, "message", P20
 246     throw P30
 247     print "not reached\n"
 248     end
 249 _handler1:
 250     get_results "0", P5
 251     set S0, P5
 252     print "caught it in 1\n"
 253     print S0
 254     print "\n"
 255     end
 256 _handler2:
 257     get_results "0", P5
 258     set S0, P5
 259     print "caught it in 2\n"
 260     print S0
 261     print "\n"
 262     rethrow P5
 263     end
 264 CODE
 265 main
 266 caught it in 2
 267 something happened
 268 caught it in 1
 269 something happened
 270 OUTPUT
 271
 272
 273 pasm_output_is( <<'CODE', <<OUT, "die, error, severity" );
 274     push_eh _handler
 275     die 3, 100
 276     print "not reached\n"
 277     end
 278 _handler:
 279     get_results "0", P5
 280     set S0, P5
 281     print "caught it\n"
 282     set I0, P5['severity']
 283     print "severity "
 284     print I0
 285     print "\n"
 286     end
 287 CODE
 288 caught it
 289 severity 3
 290 OUT
 291
 292 pasm_error_output_like( <<'CODE', <<OUT, "die - no handler" );
 293     die 3, 100
 294     print "not reached\n"
 295     end
 296 _handler:
 297     print "caught it\n"
 298     end
 299 CODE
 300 /No exception handler and no message/
 301 OUT
 302
 303 pasm_output_is( <<'CODE', '', "exit exception" );
 304     noop
 305     exit 0
 306     print "not reached\n"
 307     end
 308 CODE
 309
 310 pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
 311     print "main\n"
 312     push_eh handler
 313     print "ok\n"
 314     new P30, ['Exception']
 315     throw P30
 316     print "not reached\n"
 317     end
 318 handler:
 319     print "caught it\n"
 320     end
 321 CODE
 322 main
 323 ok
 324 caught it
 325 OUTPUT
 326 1;
 327
 328 # stringification is handled by a vtable, which runs in a second
 329 # runloop. when an error in the method tries to go to a Error_Handler defined
 330 # outside it, it winds up going to the inner runloop, giving strange results.
 331 pir_output_is( <<'CODE', <<'OUTPUT', 'pop_eh out of context (2)' );
 332 .sub main :main
 333         $P0 = get_hll_global ['Foo'], 'load'
 334         $P0()
 335         $P0 = new ['Foo']
 336         push_eh catch
 337         $S0 = $P0
 338         pop_eh
 339         say "huh?"
 340         .return()
 341
 342 catch:
 343         .get_results($P1)
 344         say "caught"
 345         finalize $P1
 346         .return()
 347 .end
 348
 349 .namespace ['Foo']
 350
 351 .sub load
 352     $P0 = newclass 'Foo'
 353 .end
 354
 355 .sub get_string :vtable :method
 356     $P0 = new ['Exception']
 357     throw $P0
 358 .end
 359 CODE
 360 caught
 361 OUTPUT
 362
 363 pir_output_is( <<'CODE', <<'OUTPUT', "exit_handler via exit exception" );
 364 .sub main :main
 365     .local pmc a
 366     .lex 'a', a
 367     a = new ['Integer']
 368     a = 42
 369     push_eh handler
 370     exit 0
 371 handler:
 372     .const 'Sub' $P0 = 'exit_handler'
 373     capture_lex $P0
 374     .tailcall $P0()
 375 .end
 376
 377 .sub exit_handler :outer(main)
 378     say "at_exit"
 379     .local pmc a
 380     a = find_lex 'a'
 381     print 'a = '
 382     say a
 383 .end
 384 CODE
 385 at_exit
 386 a = 42
 387 OUTPUT
 388
 389 ## Regression test for r14697.  This probably won't be needed when PDD23 is
 390 ## fully implemented.
 391 pir_error_output_like( <<'CODE', <<'OUTPUT', "invoke handler in calling sub", todo => "deprecate rethrow" );
 392 ## This tests that error handlers are out of scope when invoked (necessary for
 393 ## rethrow) when the error is signalled in another sub.
 394 .sub main :main
 395     push_eh handler
 396     broken()
 397     print "not reached.\n"
 398 handler:
 399     .local pmc exception
 400     .get_results (exception)
 401     $S0 = exception
 402     print "in handler.\n"
 403     print $S0
 404     print "\n"
 405     #rethrow exception
 406 .end
 407
 408 .sub broken
 409     $P0 = new ['Exception']
 410     new $P2, ['String']
 411     set $P2, "something broke"
 412     setattribute $P0, "message", $P2
 413     throw $P0
 414 .end
 415 CODE
 416 /\Ain handler.
 417 something broke
 418 something broke
 419 current inst/
 420 OUTPUT
 421
 422 pir_output_is(<<'CODE', <<'OUTPUT', "taking a continuation promotes RetCs");
 423 ## This test creates a continuation in a inner sub and re-invokes it later.  The
 424 ## re-invocation signals an error, which is caught by an intermediate sub.
 425 ## Returning from the "test" sub the second time failed in r28794; invoking
 426 ## parrot with "-D80" shows clearly that the "test" context was being recycled
 427 ## prematurely.  For some reason, it is necessary to signal the error in order
 428 ## to expose the bug.
 429 .sub main :main
 430     .local int redux
 431     .local pmc cont
 432     ## debug 0x80
 433     redux = 0
 434     print "calling test\n"
 435     cont = test()
 436     print "back from test\n"
 437     if redux goto done
 438     redux = 1
 439     print "calling cont\n"
 440     cont()
 441     print "never.\n"
 442 done:
 443     print "done.\n"
 444 .end
 445 .sub test
 446     ## Push a handler around the foo() call.
 447     push_eh handle_errs
 448     print "  calling foo\n"
 449     .local pmc cont
 450     cont = foo()
 451     print "  returning from test.\n"
 452     .return (cont)
 453 handle_errs:
 454     pop_eh
 455     print "  test:  caught error\n"
 456     .return (cont)
 457 .end
 458 .sub foo
 459     ## Take a continuation.
 460     .local pmc cont
 461     cont = new ['Continuation']
 462     set_addr cont, over_there
 463     print "    returning from foo\n"
 464     .return (cont)
 465 over_there:
 466     print "    got over there.\n"
 467     .local pmc ex
 468     ex = new ['Exception']
 469     throw ex
 470 .end
 471 CODE
 472 calling test
 473   calling foo
 474     returning from foo
 475   returning from test.
 476 back from test
 477 calling cont
 478     got over there.
 479   test:  caught error
 480 back from test
 481 done.
 482 OUTPUT
 483
 484 pir_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
 485 .sub main :main
 486     push_eh try
 487     failure()
 488     pop_eh
 489     exit 0
 490   try:
 491     .get_results($P0)
 492     pop_eh
 493     $S1 = $P0['backtrace']
 494     $S1 .= "\n"
 495     say $S1
 496 .end
 497
 498 .sub failure
 499     die 'what'
 500 .end
 501 CODE
 502 /No such string attribute/
 503 OUTPUT
 504
 505 pir_output_is( <<'CODE', <<'OUTPUT', "catch ex from C-level MULTI function" );
 506 .sub main :main
 507
 508 .local pmc p, q
 509
 510     p = new ['Integer']
 511     set p, "0"
 512
 513     push_eh handler
 514     #throw an exception from a C-level MULTI function
 515     q = p / p
 516     goto end
 517     pop_eh
 518     goto end
 519
 520 handler:
 521     .local pmc exception
 522     .local string message
 523     .get_results (exception)
 524
 525     message = exception['message']
 526     say_something(message)
 527 end:
 528 .end
 529
 530 .sub say_something
 531     .param string message
 532     #Calling this sub is enough to trigger the bug.  If execution reached this
 533     #point, the bug is fixed.
 534     say "no segfault"
 535 end:
 536 .end
 537 CODE
 538 no segfault
 539 OUTPUT
 540
 541 pir_output_is( <<'CODE', <<'OUTPUT', "count_eh" );
 542 .sub main :main
 543     $I0 = count_eh
 544     if $I0 == 0 goto right_number1
 545         print "not "
 546     right_number1:
 547     print "ok 1\n"
 548     push_eh _handler1
 549     push_eh _handler2
 550     print "ok 2\n"
 551     $I1 = count_eh
 552     if $I1 == 2 goto right_number2
 553         print "not "
 554     right_number2:
 555     print "ok 3\n"
 556     pop_eh
 557     pop_eh
 558     print "ok 4\n"
 559     $I2 = count_eh
 560     if $I2 == 0 goto right_number3
 561         print "not "
 562     right_number3:
 563     print "ok 5\n"
 564     end
 565 _handler1:
 566     print "first handler\n"
 567     end
 568 _handler2:
 569     print "second handler\n"
 570     end
 571 .end
 572 CODE
 573 ok 1
 574 ok 2
 575 ok 3
 576 ok 4
 577 ok 5
 578 OUTPUT
 579
 580 # Local Variables:
 581 #   mode: cperl
 582 #   cperl-indent-level: 4
 583 #   fill-column: 100
 584 # End:
 585 # vim: expandtab shiftwidth=4: