[svn:parrot] r41547 - in trunk: . t/pmc
dukeleto at svn.parrot.org
dukeleto at svn.parrot.org
Tue Sep 29 07:28:03 UTC 2009
Author: dukeleto
Date: Tue Sep 29 07:28:01 2009
New Revision: 41547
URL: https://trac.parrot.org/parrot/changeset/41547
Log:
[t] Add coverage for ExceptionHandler objects in a new PIR test file
Added:
trunk/t/pmc/exception-old.t
- copied unchanged from r41542, trunk/t/pmc/exception.t
Modified:
trunk/MANIFEST
trunk/t/pmc/exception.t
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Tue Sep 29 04:57:37 2009 (r41546)
+++ trunk/MANIFEST Tue Sep 29 07:28:01 2009 (r41547)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Sep 29 01:34:44 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Sep 29 07:08:19 2009 UT
#
# See below for documentation on the format of this file.
#
@@ -1808,6 +1808,7 @@
t/pmc/env.t [test]
t/pmc/eval.t [test]
t/pmc/eventhandler.t [test]
+t/pmc/exception-old.t [test]
t/pmc/exception.t [test]
t/pmc/exceptionhandler.t [test]
t/pmc/exporter.t [test]
Copied: trunk/t/pmc/exception-old.t (from r41542, trunk/t/pmc/exception.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/pmc/exception-old.t Tue Sep 29 07:28:01 2009 (r41547, copy of r41542, trunk/t/pmc/exception.t)
@@ -0,0 +1,799 @@
+#! perl
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More;
+use Parrot::Test tests => 33;
+
+=head1 NAME
+
+t/pmc/exception.t - Exception Handling
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/exception.t
+
+=head1 DESCRIPTION
+
+Tests C<Exception> and C<ExceptionHandler> PMCs.
+
+=cut
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh" );
+ push_eh _handler
+ print "ok 1\n"
+ pop_eh
+ print "ok 2\n"
+ end
+_handler:
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh, PMC exception handler" );
+.sub main :main
+ $P0 = new ['ExceptionHandler']
+ set_addr $P0, _handler
+ push_eh $P0
+ print "ok 1\n"
+ pop_eh
+ print "ok 2\n"
+ end
+_handler:
+ print "caught it\n"
+ end
+.end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
+ print "main\n"
+ push_eh _handler
+ new P30, ['Exception']
+ throw P30
+ print "not reached\n"
+ end
+_handler:
+ print "caught it\n"
+ end
+CODE
+main
+caught it
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw, PMC exception handler" );
+ print "main\n"
+ new P20, ['ExceptionHandler']
+ set_addr P20, _handler
+ push_eh P20
+ new P30, ['Exception']
+ throw P30
+ print "not reached\n"
+ end
+_handler:
+ print "caught it\n"
+ end
+CODE
+main
+caught it
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
+ print "main\n"
+ push_eh handler
+ new P1, ['Exception']
+ new P2, ['String']
+ set P2, "just pining"
+ setattribute P1, 'message', P2
+ throw P1
+ print "not reached\n"
+ end
+handler:
+ get_results "0", P0
+ set S0, P0
+ print "caught it\n"
+ typeof S1, P0
+ print S1
+ print "\n"
+ print S0
+ print "\n"
+ null P5
+ end
+
+CODE
+main
+caught it
+Exception
+just pining
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "exception attributes" );
+ print "main\n"
+ push_eh handler
+ new P1, ['Exception']
+ new P2, ['String']
+ set P2, "just pining"
+ setattribute P1, 'message', P2
+ new P3, ['Integer']
+ set P3, 5
+ setattribute P1, 'severity', P3
+ new P4, ['String']
+ set P4, "additional payload"
+ setattribute P1, 'payload', P4
+ new P5, ['Array']
+ set P5, 2
+ set P5[0], 'backtrace line 1'
+ set P5[1], 'backtrace line 2'
+ setattribute P1, 'backtrace', P5
+
+ throw P1
+ print "not reached\n"
+ end
+handler:
+ get_results "0", P0
+ set S0, P0
+ print "caught it\n"
+ getattribute P16, P0, 'message'
+ print P16
+ print "\n"
+ getattribute P17, P0, 'severity'
+ print P17
+ print "\n"
+ getattribute P18, P0, 'payload'
+ print P18
+ print "\n"
+ getattribute P19, P0, 'backtrace'
+ set P20, P19[0]
+ print P20
+ print "\n"
+ set P20, P19[1]
+ print P20
+ print "\n"
+ null P5
+ end
+
+CODE
+main
+caught it
+just pining
+5
+additional payload
+backtrace line 1
+backtrace line 2
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with String' );
+.sub main :main
+ .local pmc ex, exr
+ .local pmc msg, msgr
+ msg = new ['String']
+ msg = 'Message'
+ ex = new ['Exception'], msg
+ push_eh handler
+ throw ex
+ say 'Never here'
+handler:
+ .get_results(exr)
+ msgr = exr['message']
+ say msgr
+.end
+CODE
+Message
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with Hash' );
+.sub main :main
+ .local pmc ex, exr
+ .local pmc h, msgr
+ h = new ['Hash']
+ h['message'] = 'Message'
+ ex = new ['Exception'], h
+ push_eh handler
+ throw ex
+ say 'Never here'
+handler:
+ .get_results(exr)
+ msgr = exr['message']
+ say msgr
+.end
+CODE
+Message
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
+# see also #38459
+ print "main\n"
+ new P0, ['Integer']
+ push_eh handler
+ new P1, ['Exception']
+ new P2, ['String']
+ set P2, "just pining"
+ setattribute P1, 'message', P2
+ throw P1
+ print "not reached\n"
+ end
+handler:
+ get_results "0", P1
+ inc P0
+ print "ok\n"
+ end
+
+CODE
+main
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
+.sub main :main
+ print "main\n"
+ push_eh _handler
+ $P1 = new ['Exception']
+ $P2 = new ['String']
+ set $P2, "just pining"
+ setattribute $P1, 'message', $P2
+ throw $P1
+ print "not reached\n"
+ end
+_handler:
+ .local pmc e
+ .local string s
+ .get_results (e)
+ s = e
+ print "caught it\n"
+ typeof $S1, e
+ print $S1
+ print "\n"
+ print s
+ print "\n"
+ null $P5
+.end
+CODE
+main
+caught it
+Exception
+just pining
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw - message" );
+ print "main\n"
+ push_eh _handler
+
+ new P30, ['Exception']
+ new P20, ['String']
+ set P20, "something happened"
+ setattribute P30, "message", P20
+ throw P30
+ print "not reached\n"
+ end
+_handler:
+ get_results "0", P5
+ set S0, P5
+ print "caught it\n"
+ print S0
+ print "\n"
+ end
+CODE
+main
+caught it
+something happened
+OUTPUT
+
+pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
+ new P0, ['Exception']
+ new P20, ['String']
+ set P20, "something happened"
+ setattribute P0, "message", P20
+ throw P0
+ print "not reached\n"
+ end
+CODE
+/something happened/
+OUTPUT
+
+pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
+ push_eh _handler
+ new P0, ['Exception']
+ pop_eh
+ throw P0
+ print "not reached\n"
+ end
+_handler:
+ end
+CODE
+/No exception handler and no message/
+OUTPUT
+
+pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
+ new P0, ['Exception']
+ throw P0
+ print "not reached\n"
+ end
+CODE
+/No exception handler and no message/
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers" );
+ print "main\n"
+ push_eh _handler1
+ push_eh _handler2
+
+ new P30, ['Exception']
+ new P20, ['String']
+ set P20, "something happened"
+ setattribute P30, "message", P20
+ throw P30
+ print "not reached\n"
+ end
+_handler1:
+ get_results "0", P5
+ getattribute P2, P5, "message"
+ print "caught it in 1\n"
+ print P2
+ print "\n"
+ end
+_handler2:
+ get_results "0", P0
+ getattribute P2, P0, "message"
+ print "caught it in 2\n"
+ print P2
+ print "\n"
+ end
+CODE
+main
+caught it in 2
+something happened
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers, throw next" );
+ print "main\n"
+ push_eh _handler1
+ push_eh _handler2
+
+ new P30, ['Exception']
+ new P20, ['String']
+ set P20, "something happened"
+ setattribute P30, "message", P20
+ throw P30
+ print "not reached\n"
+ end
+_handler1:
+ get_results "0", P5
+ set S0, P5
+ print "caught it in 1\n"
+ print S0
+ print "\n"
+ end
+_handler2:
+ get_results "0", P5
+ set S0, P5
+ print "caught it in 2\n"
+ print S0
+ print "\n"
+ rethrow P5
+ end
+CODE
+main
+caught it in 2
+something happened
+caught it in 1
+something happened
+OUTPUT
+
+pasm_output_is( <<'CODE', <<OUT, "die" );
+ push_eh _handler
+ die 3, 100
+ print "not reached\n"
+ end
+_handler:
+ print "caught it\n"
+ end
+CODE
+caught it
+OUT
+
+pasm_output_is( <<'CODE', <<OUT, "die, error, severity" );
+ push_eh _handler
+ die 3, 100
+ print "not reached\n"
+ end
+_handler:
+ get_results "0", P5
+ set S0, P5
+ print "caught it\n"
+ set I0, P5['severity']
+ print "severity "
+ print I0
+ print "\n"
+ end
+CODE
+caught it
+severity 3
+OUT
+
+pasm_error_output_like( <<'CODE', <<OUT, "die - no handler" );
+ die 3, 100
+ print "not reached\n"
+ end
+_handler:
+ print "caught it\n"
+ end
+CODE
+/No exception handler and no message/
+OUT
+
+pasm_output_is( <<'CODE', '', "exit exception" );
+ noop
+ exit 0
+ print "not reached\n"
+ end
+CODE
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
+ print "main\n"
+ push_eh handler
+ print "ok\n"
+ new P30, ['Exception']
+ throw P30
+ print "not reached\n"
+ end
+handler:
+ print "caught it\n"
+ end
+CODE
+main
+ok
+caught it
+OUTPUT
+1;
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "pushmark" );
+ pushmark 10
+ print "ok 1\n"
+ popmark 10
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+pasm_output_is( <<'CODE', <<'OUTPUT', "pushmark nested" );
+ pushmark 10
+ pushmark 11
+ print "ok 1\n"
+ popmark 11
+ popmark 10
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+pasm_error_output_like( <<'CODE', <<'OUTPUT', "pushmark - pop wrong one" );
+ pushmark 10
+ print "ok 1\n"
+ popmark 500
+ print "never\n"
+ end
+CODE
+/Mark 500 not found/
+OUTPUT
+
+# stringification is handled by a vtable method, which runs in a second
+# runloop. when an error in the method tries to go to a Error_Handler defined
+# outside it, it winds up going to the inner runloop, giving strange results.
+pir_output_is( <<'CODE', <<'OUTPUT', 'pop_eh out of context (2)', todo => 'runloop shenanigans' );
+.sub main :main
+ $P0 = get_hll_global ['Foo'], 'load'
+ $P0()
+ $P0 = new ['Foo']
+ push_eh catch
+ $S0 = $P0
+ pop_eh
+ say "huh?"
+ .return()
+
+catch:
+ say "caught"
+ .return()
+.end
+
+.namespace ['Foo']
+
+.sub load
+ $P0 = newclass 'Foo'
+.end
+
+.sub get_string :vtable :method
+ $P0 = new ['Exception']
+ throw $P0
+.end
+CODE
+caught
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', "pushaction - throw in main" );
+.sub main :main
+ print "main\n"
+ .const 'Sub' at_exit = "exit_handler"
+ pushaction at_exit
+ $P0 = new ['Exception']
+ throw $P0
+ .return()
+.end
+
+.sub exit_handler
+ .param int flag
+ print "at_exit, flag = "
+ say flag
+.end
+CODE
+/^main
+No exception handler/
+OUTPUT
+
+# exception handlers are still run in an inferior runloop, which messes up
+# nonlocal exit from within handlers.
+pir_output_like(
+ <<'CODE', <<'OUTPUT', "pushaction: error while handling error", todo => 'runloop shenanigans' );
+.sub main :main
+ push_eh h
+ print "main\n"
+ .const 'Sub' at_exit = "exit_handler"
+ pushaction at_exit
+ $P1 = new ['Exception']
+ throw $P1
+ print "never 1\n"
+h:
+ ## this is never actually reached, because exit_handler throws an unhandled
+ ## exception before the handler is entered.
+ print "in outer handler\n"
+.end
+
+.sub exit_handler :outer(main)
+ .param int flag
+ print "at_exit, flag = "
+ say flag
+ $P2 = new ['Exception']
+ throw $P2
+ print "never 2\n"
+.end
+CODE
+/^main
+at_exit, flag = 1
+No exception handler/
+OUTPUT
+
+$ENV{TEST_PROG_ARGS} ||= '';
+my @todo = $ENV{TEST_PROG_ARGS} =~ /--run-pbc/
+ ? ( todo => '.tailcall and lexical maps not thawed from PBC, RT #60650' )
+ : ();
+pir_output_is( <<'CODE', <<'OUTPUT', "exit_handler via exit exception", @todo );
+.sub main :main
+ .local pmc a
+ .lex 'a', a
+ a = new ['Integer']
+ a = 42
+ push_eh handler
+ exit 0
+handler:
+ .tailcall exit_handler()
+.end
+
+.sub exit_handler :outer(main)
+ say "at_exit"
+ .local pmc a
+ a = find_lex 'a'
+ print 'a = '
+ say a
+.end
+CODE
+at_exit
+a = 42
+OUTPUT
+
+## Regression test for r14697. This probably won't be needed when PDD23 is
+## fully implemented.
+pir_error_output_like( <<'CODE', <<'OUTPUT', "invoke handler in calling sub", todo => "deprecate rethrow" );
+## This tests that error handlers are out of scope when invoked (necessary for
+## rethrow) when the error is signalled in another sub.
+.sub main :main
+ push_eh handler
+ broken()
+ print "not reached.\n"
+handler:
+ .local pmc exception
+ .get_results (exception)
+ $S0 = exception
+ print "in handler.\n"
+ print $S0
+ print "\n"
+ #rethrow exception
+.end
+
+.sub broken
+ $P0 = new ['Exception']
+ new $P2, ['String']
+ set $P2, "something broke"
+ setattribute $P0, "message", $P2
+ throw $P0
+.end
+CODE
+/\Ain handler.
+something broke
+something broke
+current inst/
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "taking a continuation promotes RetCs");
+## This test creates a continuation in a inner sub and re-invokes it later. The
+## re-invocation signals an error, which is caught by an intermediate sub.
+## Returning from the "test" sub the second time failed in r28794; invoking
+## parrot with "-D80" shows clearly that the "test" context was being recycled
+## prematurely. For some reason, it is necessary to signal the error in order
+## to expose the bug.
+.sub main :main
+ .local int redux
+ .local pmc cont
+ ## debug 0x80
+ redux = 0
+ print "calling test\n"
+ cont = test()
+ print "back from test\n"
+ if redux goto done
+ redux = 1
+ print "calling cont\n"
+ cont()
+ print "never.\n"
+done:
+ print "done.\n"
+.end
+.sub test
+ ## Push a handler around the foo() call.
+ push_eh handle_errs
+ print " calling foo\n"
+ .local pmc cont
+ cont = foo()
+ print " returning from test.\n"
+ .return (cont)
+handle_errs:
+ pop_eh
+ print " test: caught error\n"
+ .return (cont)
+.end
+.sub foo
+ ## Take a continuation.
+ .local pmc cont
+ cont = new ['Continuation']
+ set_addr cont, over_there
+ print " returning from foo\n"
+ .return (cont)
+over_there:
+ print " got over there.\n"
+ .local pmc ex
+ ex = new ['Exception']
+ throw ex
+.end
+CODE
+calling test
+ calling foo
+ returning from foo
+ returning from test.
+back from test
+calling cont
+ got over there.
+ test: caught error
+back from test
+done.
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
+.sub main :main
+ push_eh try
+ failure()
+ pop_eh
+ exit 0
+ try:
+ .get_results($P0)
+ pop_eh
+ $S1 = $P0['backtrace']
+ $S1 .= "\n"
+ say $S1
+.end
+
+.sub failure
+ die 'what'
+.end
+CODE
+/No such string attribute/
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "catch ex from C-level MULTI function" );
+.sub main :main
+
+.local pmc p, q
+
+ p = new ['Integer']
+ set p, "0"
+
+ push_eh handler
+ #throw an exception from a C-level MULTI function
+ q = p / p
+ goto end
+ pop_eh
+ goto end
+
+handler:
+ .local pmc exception
+ .local string message
+ .get_results (exception)
+
+ message = exception['message']
+ say_something(message)
+end:
+.end
+
+.sub say_something
+ .param string message
+ #Calling this sub is enough to trigger the bug. If execution reached this
+ #point, the bug is fixed.
+ say "no segfault"
+end:
+.end
+CODE
+no segfault
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "count_eh" );
+.sub main :main
+ $I0 = count_eh
+ if $I0 == 0 goto right_number1
+ print "not "
+ right_number1:
+ print "ok 1\n"
+ push_eh _handler1
+ push_eh _handler2
+ print "ok 2\n"
+ $I1 = count_eh
+ if $I1 == 2 goto right_number2
+ print "not "
+ right_number2:
+ print "ok 3\n"
+ pop_eh
+ pop_eh
+ print "ok 4\n"
+ $I2 = count_eh
+ if $I2 == 0 goto right_number3
+ print "not "
+ right_number3:
+ print "ok 5\n"
+ end
+_handler1:
+ print "first handler\n"
+ end
+_handler2:
+ print "second handler\n"
+ end
+.end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+OUTPUT
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: trunk/t/pmc/exception.t
==============================================================================
--- trunk/t/pmc/exception.t Tue Sep 29 04:57:37 2009 (r41546)
+++ trunk/t/pmc/exception.t Tue Sep 29 07:28:01 2009 (r41547)
@@ -1,13 +1,7 @@
-#! perl
-# Copyright (C) 2001-2008, Parrot Foundation.
+#! parrot
+# Copyright (C) 2009, Parrot Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 33;
-
=head1 NAME
t/pmc/exception.t - Exception Handling
@@ -22,778 +16,47 @@
=cut
-pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh" );
- push_eh _handler
- print "ok 1\n"
- pop_eh
- print "ok 2\n"
- end
-_handler:
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh, PMC exception handler" );
-.sub main :main
- $P0 = new ['ExceptionHandler']
- set_addr $P0, _handler
- push_eh $P0
- print "ok 1\n"
- pop_eh
- print "ok 2\n"
- end
-_handler:
- print "caught it\n"
- end
-.end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
- print "main\n"
- push_eh _handler
- new P30, ['Exception']
- throw P30
- print "not reached\n"
- end
-_handler:
- print "caught it\n"
- end
-CODE
-main
-caught it
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw, PMC exception handler" );
- print "main\n"
- new P20, ['ExceptionHandler']
- set_addr P20, _handler
- push_eh P20
- new P30, ['Exception']
- throw P30
- print "not reached\n"
- end
-_handler:
- print "caught it\n"
- end
-CODE
-main
-caught it
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
- print "main\n"
- push_eh handler
- new P1, ['Exception']
- new P2, ['String']
- set P2, "just pining"
- setattribute P1, 'message', P2
- throw P1
- print "not reached\n"
- end
-handler:
- get_results "0", P0
- set S0, P0
- print "caught it\n"
- typeof S1, P0
- print S1
- print "\n"
- print S0
- print "\n"
- null P5
- end
-
-CODE
-main
-caught it
-Exception
-just pining
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "exception attributes" );
- print "main\n"
- push_eh handler
- new P1, ['Exception']
- new P2, ['String']
- set P2, "just pining"
- setattribute P1, 'message', P2
- new P3, ['Integer']
- set P3, 5
- setattribute P1, 'severity', P3
- new P4, ['String']
- set P4, "additional payload"
- setattribute P1, 'payload', P4
- new P5, ['Array']
- set P5, 2
- set P5[0], 'backtrace line 1'
- set P5[1], 'backtrace line 2'
- setattribute P1, 'backtrace', P5
-
- throw P1
- print "not reached\n"
- end
-handler:
- get_results "0", P0
- set S0, P0
- print "caught it\n"
- getattribute P16, P0, 'message'
- print P16
- print "\n"
- getattribute P17, P0, 'severity'
- print P17
- print "\n"
- getattribute P18, P0, 'payload'
- print P18
- print "\n"
- getattribute P19, P0, 'backtrace'
- set P20, P19[0]
- print P20
- print "\n"
- set P20, P19[1]
- print P20
- print "\n"
- null P5
- end
-
-CODE
-main
-caught it
-just pining
-5
-additional payload
-backtrace line 1
-backtrace line 2
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with String' );
-.sub main :main
- .local pmc ex, exr
- .local pmc msg, msgr
- msg = new ['String']
- msg = 'Message'
- ex = new ['Exception'], msg
- push_eh handler
- throw ex
- say 'Never here'
-handler:
- .get_results(exr)
- msgr = exr['message']
- say msgr
-.end
-CODE
-Message
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with Hash' );
.sub main :main
- .local pmc ex, exr
- .local pmc h, msgr
- h = new ['Hash']
- h['message'] = 'Message'
- ex = new ['Exception'], h
- push_eh handler
- throw ex
- say 'Never here'
-handler:
- .get_results(exr)
- msgr = exr['message']
- say msgr
+ .include 'test_more.pir'
+ plan( 6 )
+ test_bool()
+ test_int()
+ test_attrs()
.end
-CODE
-Message
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
-# see also #38459
- print "main\n"
- new P0, ['Integer']
- push_eh handler
- new P1, ['Exception']
- new P2, ['String']
- set P2, "just pining"
- setattribute P1, 'message', P2
- throw P1
- print "not reached\n"
- end
-handler:
- get_results "0", P1
- inc P0
- print "ok\n"
- end
-
-CODE
-main
-ok
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
-.sub main :main
- print "main\n"
- push_eh _handler
- $P1 = new ['Exception']
- $P2 = new ['String']
- set $P2, "just pining"
- setattribute $P1, 'message', $P2
- throw $P1
- print "not reached\n"
- end
-_handler:
- .local pmc e
- .local string s
- .get_results (e)
- s = e
- print "caught it\n"
- typeof $S1, e
- print $S1
- print "\n"
- print s
- print "\n"
- null $P5
-.end
-CODE
-main
-caught it
-Exception
-just pining
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw - message" );
- print "main\n"
- push_eh _handler
-
- new P30, ['Exception']
- new P20, ['String']
- set P20, "something happened"
- setattribute P30, "message", P20
- throw P30
- print "not reached\n"
- end
-_handler:
- get_results "0", P5
- set S0, P5
- print "caught it\n"
- print S0
- print "\n"
- end
-CODE
-main
-caught it
-something happened
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
- new P0, ['Exception']
- new P20, ['String']
- set P20, "something happened"
- setattribute P0, "message", P20
- throw P0
- print "not reached\n"
- end
-CODE
-/something happened/
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
- push_eh _handler
- new P0, ['Exception']
- pop_eh
- throw P0
- print "not reached\n"
- end
-_handler:
- end
-CODE
-/No exception handler and no message/
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler, no message" );
- new P0, ['Exception']
- throw P0
- print "not reached\n"
- end
-CODE
-/No exception handler and no message/
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers" );
- print "main\n"
- push_eh _handler1
- push_eh _handler2
-
- new P30, ['Exception']
- new P20, ['String']
- set P20, "something happened"
- setattribute P30, "message", P20
- throw P30
- print "not reached\n"
- end
-_handler1:
- get_results "0", P5
- getattribute P2, P5, "message"
- print "caught it in 1\n"
- print P2
- print "\n"
- end
-_handler2:
- get_results "0", P0
- getattribute P2, P0, "message"
- print "caught it in 2\n"
- print P2
- print "\n"
- end
-CODE
-main
-caught it in 2
-something happened
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "2 exception handlers, throw next" );
- print "main\n"
- push_eh _handler1
- push_eh _handler2
-
- new P30, ['Exception']
- new P20, ['String']
- set P20, "something happened"
- setattribute P30, "message", P20
- throw P30
- print "not reached\n"
- end
-_handler1:
- get_results "0", P5
- set S0, P5
- print "caught it in 1\n"
- print S0
- print "\n"
- end
-_handler2:
- get_results "0", P5
- set S0, P5
- print "caught it in 2\n"
- print S0
- print "\n"
- rethrow P5
- end
-CODE
-main
-caught it in 2
-something happened
-caught it in 1
-something happened
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUT, "die" );
- push_eh _handler
- die 3, 100
- print "not reached\n"
- end
-_handler:
- print "caught it\n"
- end
-CODE
-caught it
-OUT
-
-pasm_output_is( <<'CODE', <<OUT, "die, error, severity" );
- push_eh _handler
- die 3, 100
- print "not reached\n"
- end
-_handler:
- get_results "0", P5
- set S0, P5
- print "caught it\n"
- set I0, P5['severity']
- print "severity "
- print I0
- print "\n"
- end
-CODE
-caught it
-severity 3
-OUT
-
-pasm_error_output_like( <<'CODE', <<OUT, "die - no handler" );
- die 3, 100
- print "not reached\n"
- end
+.sub test_bool
+ $P0 = new 'ExceptionHandler'
+ set_addr $P0, _handler
+ ok($P0,'ExceptionHandler objects return true')
+ .return()
_handler:
- print "caught it\n"
- end
-CODE
-/No exception handler and no message/
-OUT
-
-pasm_output_is( <<'CODE', '', "exit exception" );
- noop
- exit 0
- print "not reached\n"
- end
-CODE
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
- print "main\n"
- push_eh handler
- print "ok\n"
- new P30, ['Exception']
- throw P30
- print "not reached\n"
- end
-handler:
- print "caught it\n"
- end
-CODE
-main
-ok
-caught it
-OUTPUT
-1;
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "pushmark" );
- pushmark 10
- print "ok 1\n"
- popmark 10
- print "ok 2\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "pushmark nested" );
- pushmark 10
- pushmark 11
- print "ok 1\n"
- popmark 11
- popmark 10
- print "ok 2\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "pushmark - pop wrong one" );
- pushmark 10
- print "ok 1\n"
- popmark 500
- print "never\n"
- end
-CODE
-/Mark 500 not found/
-OUTPUT
-
-# stringification is handled by a vtable method, which runs in a second
-# runloop. when an error in the method tries to go to a Error_Handler defined
-# outside it, it winds up going to the inner runloop, giving strange results.
-pir_output_is( <<'CODE', <<'OUTPUT', 'pop_eh out of context (2)', todo => 'runloop shenanigans' );
-.sub main :main
- $P0 = get_hll_global ['Foo'], 'load'
- $P0()
- $P0 = new ['Foo']
- push_eh catch
- $S0 = $P0
- pop_eh
- say "huh?"
- .return()
-
-catch:
- say "caught"
- .return()
-.end
-
-.namespace ['Foo']
-
-.sub load
- $P0 = newclass 'Foo'
+ say "howdy bool!"
.end
-.sub get_string :vtable :method
- $P0 = new ['Exception']
- throw $P0
-.end
-CODE
-caught
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', "pushaction - throw in main" );
-.sub main :main
- print "main\n"
- .const 'Sub' at_exit = "exit_handler"
- pushaction at_exit
- $P0 = new ['Exception']
- throw $P0
+.sub test_int
+ $P0 = new 'ExceptionHandler'
+ set_addr $P0, _handler
+ push_eh $P0
+ $I0 = $P0
+ ok(1,'get_integer on ExceptionHandler ')
.return()
+_handler:
+ say "howdy int!"
.end
-.sub exit_handler
- .param int flag
- print "at_exit, flag = "
- say flag
-.end
-CODE
-/^main
-No exception handler/
-OUTPUT
-
-# exception handlers are still run in an inferior runloop, which messes up
-# nonlocal exit from within handlers.
-pir_output_like(
- <<'CODE', <<'OUTPUT', "pushaction: error while handling error", todo => 'runloop shenanigans' );
-.sub main :main
- push_eh h
- print "main\n"
- .const 'Sub' at_exit = "exit_handler"
- pushaction at_exit
- $P1 = new ['Exception']
- throw $P1
- print "never 1\n"
-h:
- ## this is never actually reached, because exit_handler throws an unhandled
- ## exception before the handler is entered.
- print "in outer handler\n"
-.end
-
-.sub exit_handler :outer(main)
- .param int flag
- print "at_exit, flag = "
- say flag
- $P2 = new ['Exception']
- throw $P2
- print "never 2\n"
-.end
-CODE
-/^main
-at_exit, flag = 1
-No exception handler/
-OUTPUT
-
-$ENV{TEST_PROG_ARGS} ||= '';
-my @todo = $ENV{TEST_PROG_ARGS} =~ /--run-pbc/
- ? ( todo => '.tailcall and lexical maps not thawed from PBC, RT #60650' )
- : ();
-pir_output_is( <<'CODE', <<'OUTPUT', "exit_handler via exit exception", @todo );
-.sub main :main
- .local pmc a
- .lex 'a', a
- a = new ['Integer']
- a = 42
- push_eh handler
- exit 0
-handler:
- .tailcall exit_handler()
-.end
-
-.sub exit_handler :outer(main)
- say "at_exit"
- .local pmc a
- a = find_lex 'a'
- print 'a = '
- say a
-.end
-CODE
-at_exit
-a = 42
-OUTPUT
-
-## Regression test for r14697. This probably won't be needed when PDD23 is
-## fully implemented.
-pir_error_output_like( <<'CODE', <<'OUTPUT', "invoke handler in calling sub", todo => "deprecate rethrow" );
-## This tests that error handlers are out of scope when invoked (necessary for
-## rethrow) when the error is signalled in another sub.
-.sub main :main
- push_eh handler
- broken()
- print "not reached.\n"
-handler:
- .local pmc exception
- .get_results (exception)
- $S0 = exception
- print "in handler.\n"
- print $S0
- print "\n"
- #rethrow exception
-.end
-
-.sub broken
- $P0 = new ['Exception']
- new $P2, ['String']
- set $P2, "something broke"
- setattribute $P0, "message", $P2
+.sub test_attrs
+ $P0 = new 'ExceptionHandler'
+ set_addr $P0, _handler
+ push_eh $P0
throw $P0
+_handler:
+ get_results "0", $P0
+ getattribute $P1, $P0, 'type'
+ ok(1,'got type')
+ getattribute $P2, $P0, 'handled'
+ is($P2,0,'got handled')
+ getattribute $P3, $P0, 'exit_code'
+ is($P2,0,'got exit_code')
+ getattribute $P4, $P0, 'severity'
+ ok(1,'got severity')
.end
-CODE
-/\Ain handler.
-something broke
-something broke
-current inst/
-OUTPUT
-
-pir_output_is(<<'CODE', <<'OUTPUT', "taking a continuation promotes RetCs");
-## This test creates a continuation in a inner sub and re-invokes it later. The
-## re-invocation signals an error, which is caught by an intermediate sub.
-## Returning from the "test" sub the second time failed in r28794; invoking
-## parrot with "-D80" shows clearly that the "test" context was being recycled
-## prematurely. For some reason, it is necessary to signal the error in order
-## to expose the bug.
-.sub main :main
- .local int redux
- .local pmc cont
- ## debug 0x80
- redux = 0
- print "calling test\n"
- cont = test()
- print "back from test\n"
- if redux goto done
- redux = 1
- print "calling cont\n"
- cont()
- print "never.\n"
-done:
- print "done.\n"
-.end
-.sub test
- ## Push a handler around the foo() call.
- push_eh handle_errs
- print " calling foo\n"
- .local pmc cont
- cont = foo()
- print " returning from test.\n"
- .return (cont)
-handle_errs:
- pop_eh
- print " test: caught error\n"
- .return (cont)
-.end
-.sub foo
- ## Take a continuation.
- .local pmc cont
- cont = new ['Continuation']
- set_addr cont, over_there
- print " returning from foo\n"
- .return (cont)
-over_there:
- print " got over there.\n"
- .local pmc ex
- ex = new ['Exception']
- throw ex
-.end
-CODE
-calling test
- calling foo
- returning from foo
- returning from test.
-back from test
-calling cont
- got over there.
- test: caught error
-back from test
-done.
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', "throw - no handler" );
-.sub main :main
- push_eh try
- failure()
- pop_eh
- exit 0
- try:
- .get_results($P0)
- pop_eh
- $S1 = $P0['backtrace']
- $S1 .= "\n"
- say $S1
-.end
-
-.sub failure
- die 'what'
-.end
-CODE
-/No such string attribute/
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "catch ex from C-level MULTI function" );
-.sub main :main
-
-.local pmc p, q
-
- p = new ['Integer']
- set p, "0"
-
- push_eh handler
- #throw an exception from a C-level MULTI function
- q = p / p
- goto end
- pop_eh
- goto end
-
-handler:
- .local pmc exception
- .local string message
- .get_results (exception)
-
- message = exception['message']
- say_something(message)
-end:
-.end
-
-.sub say_something
- .param string message
- #Calling this sub is enough to trigger the bug. If execution reached this
- #point, the bug is fixed.
- say "no segfault"
-end:
-.end
-CODE
-no segfault
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "count_eh" );
-.sub main :main
- $I0 = count_eh
- if $I0 == 0 goto right_number1
- print "not "
- right_number1:
- print "ok 1\n"
- push_eh _handler1
- push_eh _handler2
- print "ok 2\n"
- $I1 = count_eh
- if $I1 == 2 goto right_number2
- print "not "
- right_number2:
- print "ok 3\n"
- pop_eh
- pop_eh
- print "ok 4\n"
- $I2 = count_eh
- if $I2 == 0 goto right_number3
- print "not "
- right_number3:
- print "ok 5\n"
- end
-_handler1:
- print "first handler\n"
- end
-_handler2:
- print "second handler\n"
- end
-.end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-OUTPUT
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list