Index: t/pmc/capture.t
===================================================================
--- t/pmc/capture.t	(revision 39239)
+++ t/pmc/capture.t	(working copy)
@@ -1,14 +1,7 @@
-#!perl
+#!parrot
 # Copyright (C) 2001-2008, Parrot Foundation.
 # $Id$
 
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Test tests => 8;
-
 =head1 NAME
 
 t/pmc/capture.t - Test the Capture PMC
@@ -24,296 +17,320 @@
 
 =cut
 
-my $PRE = <<PRE;
-.sub 'test' :main
-    .local pmc capt
-    capt = new ['Capture']
-PRE
+.namespace []
 
-my $POST = <<POST;
+.include "except_types.pasm"
+
+.sub main :main
+    .include 'test_more.pir'
+
+    plan(47)
+
+    new_test() # 1 test
+    basic_capture_tests() # 23 tests
+    defined_delete_exists() # 16 tests
+    hash_list() # 2 tests
+    get_integer_not_implemented() # 1 test
+    get_number_not_implemented() # 1 test
+    keyed_int_delegation() # 2 tests
+    list_method_delegation() # 1 test
+.end
+
+.sub new_test
+    .local pmc capt, eh
+
+    eh = new ['ExceptionHandler']
+#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED)
+    set_addr eh, eh_label
+
+    push_eh eh
+      capt = new ['Capture']
+    pop_eh
+
+    ok(1, 'new works correctly')
     goto end
-  nok:
-    print 'not '
-  ok:
-    say 'ok'
-  end:
+
+eh_label:
+    ok(0, 'new does not work correctly')
+
+end:
 .end
-POST
 
-pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', 'new' );
-CODE
-OUT
+.sub basic_capture_tests
+    .local pmc capt, intpmc, pval
+    .local int ival
+    .local num nval
+    .local string sval
 
-pir_output_is( <<'CODE', <<'OUTPUT', "Basic capture tests" );
-.sub main :main
-    .local pmc capt
     capt = new ['Capture']
 
     capt[0] = 0
     capt[1] = 1.5
     capt[2] = 'two'
-    $P0 = new ['Integer']
-    $P0 = 3
-    capt[3] = $P0
+    intpmc = new ['Integer']
+    intpmc = 3
+    capt[3] = intpmc
 
     push capt, 4
     push capt, 5.5
     push capt, 'six'
-    $P0 = new ['Integer']
-    $P0 = 7
-    push capt, $P0
+    intpmc = new ['Integer']
+    intpmc = 7
+    push capt, intpmc
 
     unshift capt, 8
     unshift capt, 9.5
     unshift capt, 'ten'
-    $P0 = new ['Integer']
-    $P0 = 11
-    unshift capt, $P0
+    intpmc = new ['Integer']
+    intpmc = 11
+    unshift capt, intpmc
 
     capt['alpha'] = 12
     capt['beta'] = 13.5
     capt['gamma'] = 'fourteen'
-    $P0 = new ['Integer']
-    $P0 = 15
-    capt['delta'] = $P0
+    intpmc = new ['Integer']
+    intpmc = 15
+    capt['delta'] = intpmc
 
-    $I0 = elements capt
-    print $I0
-    print "\n"
+    ival = elements capt
+    is(ival, 12, '12 elements count of capture correctly')
 
-    $I0 = capt[11]
-    print $I0
-    print " "
-    $P0 = capt[10]
-    print $P0
-    print " "
-    $N0 = capt[9]
-    print $N0
-    print " "
-    $S0 = capt[8]
-    say $S0
+    ival = capt[11]
+    is(ival, 7, 'element 11 of capture is correct')
 
-    $I0 = pop capt
-    print $I0
-    print " "
-    $P0 = pop capt
-    print $P0
-    print " "
-    $N0 = pop capt
-    print $N0
-    print " "
-    $S0 = pop capt
-    say $S0
+    pval = capt[10]
+    is(pval, 'six', 'element 10 of capture is correct')
 
-    $I0 = elements capt
-    print $I0
-    print "\n"
+    nval = capt[9]
+    is(nval, '5.5', 'element 9 of capture is correct')
 
-    $I0 = shift capt
-    print $I0
-    print " "
-    $P0 = shift capt
-    print $P0
-    print " "
-    $N0 = shift capt
-    print $N0
-    print " "
-    $S0 = shift capt
-    say $S0
+    sval = capt[8]
+    is(sval, '4', 'element 8 of capture is correct')
 
-    $I0 = elements capt
-    print $I0
-    print "\n"
+    ival = pop capt
+    is(ival, 7, 'first popped element of capture is correct')
 
-  loop:
-    $I0 = elements capt
-    if $I0 < 1 goto end
-    $P0 = pop capt
-    say $P0
-    goto loop
-  end:
+    pval = pop capt
+    is(pval, 'six', 'second popped element of capture is correct')
 
-    $I0 = capt['delta']
-    print $I0
-    print " "
-    $P0 = capt['gamma']
-    print $P0
-    print " "
-    $N0 = capt['beta']
-    print $N0
-    print " "
-    $S0 = capt['alpha']
-    say $S0
+    nval = pop capt
+    is(nval, '5.5', 'third popped element of capture is correct')
 
+    sval = pop capt
+    is(sval, '4', 'fourth popped element of capture is correct')
+
+    ival = elements capt
+    is(ival, 8, 'number of element after 4 pops is correct')
+
+    ival = shift capt
+    is(ival, 11, 'first shifted element of is correct')
+
+    pval = shift capt
+    is(pval, 'ten', 'second shifted element of capture is correct')
+
+    nval = shift capt
+    is(nval, '9.5', 'third shifted element of capture is correct')
+
+    sval = shift capt
+    is(sval, '8', 'fourth shifted element of capture is correct')
+
+    ival = elements capt
+    is(ival, 4, 'number of element after 4 shifts is correct')
+
+    pval = pop capt
+    is(pval, 3, 'first popped element of capture is correct')
+
+    pval = pop capt
+    is(pval, 'two', 'second popped element of capture is correct')
+
+    pval = pop capt
+    is(pval, '1.5', 'third popped element of capture is correct')
+
+    pval = pop capt
+    is(pval, '0', 'fourth popped element of capture is correct')
+
+    ival = capt['delta']
+    is(ival, 15, 'integer keyed element of capture is correct')
+
+    pval = capt['gamma']
+    is(pval, 'fourteen', 'pmc keyed element of capture is correct')
+
+    nval = capt['beta']
+    is(nval, 13.5, 'number keyed element of capture is correct')
+
+    sval = capt['alpha']
+    is(sval, '12', 'string keyed element of capture is correct')
 .end
 
-CODE
-12
-7 six 5.5 4
-7 six 5.5 4
-8
-11 ten 9.5 8
-4
-3
-two
-1.5
-0
-15 fourteen 13.5 12
-OUTPUT
+.sub defined_delete_exists
+    .local pmc capt,pval
+    .local int defined_bool, exists_bool
 
-pir_output_is( <<'CODE', <<'OUTPUT', "defined, delete, exists" );
-.sub main :main
-    .local pmc capt
     capt = new ['Capture']
 
-    $I0 = defined capt[2]
-    $I1 = exists capt[2]
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    defined_bool = defined capt[2]
+    is(defined_bool, 0, 'uninitialised indexed element is undefined correctly')
 
-    $I0 = defined capt['alpha']
-    $I1 = exists capt['alpha']
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    exists_bool = exists capt[2]
+    is(exists_bool, 0, 'uninitialised indexed element does not exist correctly')
 
+    defined_bool = defined capt['alpha']
+    is(defined_bool, 0, 'uninitialised keyed element is undefined correctly')
+
+    exists_bool = exists capt['alpha']
+    is(exists_bool, 0, 'uninitialised keyed element does not exist correctly')
+
     capt[2] = 1
     capt['alpha'] = 1
-    $P0 = new ['Undef']
-    capt['beta'] = $P0
+    pval = new ['Undef']
+    capt['beta'] = pval
 
-    $I0 = defined capt[2]
-    $I1 = exists capt[2]
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    defined_bool = defined capt[2]
+    is(defined_bool, 1, 'initialised indexed element is defined correctly')
 
-    $I0 = defined capt['alpha']
-    $I1 = exists capt['alpha']
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    exists_bool = exists capt[2]
+    is(exists_bool, 1, 'initialised indexed element exists correctly')
 
-    $I0 = defined capt[1]
-    $I1 = exists capt[1]
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    defined_bool = defined capt['alpha']
+    is(defined_bool, 1, 'initialised keyed element is defined correctly')
 
-    $I0 = defined capt['beta']
-    $I1 = exists capt['beta']
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    exists_bool = exists capt['alpha']
+    is(exists_bool, 1, 'initialised keyed element exists correctly')
 
+    defined_bool = defined capt[1]
+    is(defined_bool, 0, 'uninitialised indexed element is undefined correctly')
+
+    exists_bool = exists capt[1]
+    is(exists_bool, 0, 'uninitialised indexed element does not exist correctly')
+
+    defined_bool = defined capt['beta']
+    is(defined_bool, 0, 'null initialised keyed element is undefined correctly')
+
+    exists_bool = exists capt['beta']
+    is(exists_bool, 1, 'null initialised keyed element exists correctly')
+
     delete capt[2]
     delete capt['alpha']
 
-    $I0 = defined capt[2]
-    $I1 = exists capt[2]
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    defined_bool = defined capt[2]
+    is(defined_bool, 0, 'deleted indexed element is undefined correctly')
 
-    $I0 = defined capt['alpha']
-    $I1 = exists capt['alpha']
-    print $I0
-    print " "
-    print $I1
-    print "\n"
+    exists_bool = exists capt[2]
+    is(exists_bool, 0, 'deleted indexed element does not exist correctly')
 
+    defined_bool = defined capt['alpha']
+    is(defined_bool, 0, 'deleted keyed element is undefined correctly')
 
+    exists_bool = exists capt['alpha']
+    is(exists_bool, 0, 'deleted keyed element does not exist correctly')
 .end
-CODE
-0 0
-0 0
-1 1
-1 1
-0 0
-0 1
-0 0
-0 0
-OUTPUT
 
-pir_output_is( $PRE . <<'CODE'. $POST, <<'OUTPUT', "hash, list" );
-    $P0 = capt.'list'()
-    $P1 = capt.'hash'()
+.sub hash_list
+    .local pmc capt, list_pmc, hash_pmc
+    .local string list_type, hash_type
 
-    $S0 = typeof $P0
-    $S1 = typeof $P1
+    capt = new ['Capture']
 
-    say $S0
-    say $S1
-CODE
-ResizablePMCArray
-Hash
-OUTPUT
+    list_pmc = capt.'list'()
+    hash_pmc = capt.'hash'()
 
-pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_integer not implemented' );
-    $I0 = capt
-CODE
-/get_integer\(\) not implemented in class 'Capture'/
-OUT
+    list_type = typeof list_pmc
+    is(list_type, 'ResizablePMCArray', 'list is correct type')
 
-pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_number not implemented' );
-    $N0 = capt
-CODE
-/get_number\(\) not implemented in class 'Capture'/
-OUT
+    hash_type = typeof hash_pmc
+    is(hash_type, 'Hash', 'hash is correct type')
+.end
 
-pir_output_is( <<'CODE', <<'OUTPUT', '*_keyed_int delegation' );
-.sub main :main
-    $P99 = subclass 'Capture', 'Match'
-    $P1 = new ['Match']
-    $P1[1] = 1
-    $I1 = elements $P1
-    print $I1
-    print "\n"
+.sub get_integer_not_implemented
+    .local pmc capt, eh
+    .local int ival
 
-    $P99 = subclass 'Match', 'Exp'
-    $P2 = new ['Exp']
-    $P2[1] = 1
-    $I2 = elements $P2
-    print $I2
-    print "\n"
+    eh = new ['ExceptionHandler']
+#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED)
+    set_addr eh, eh_label
 
+    capt = new ['Capture']
+
+    push_eh eh
+      ival = capt
+    pop_eh
+
+    ok(0, 'get_integer_not_implemented')
+    goto end
+
+eh_label:
+    .local string message
+    .get_results($P0)
+    message = $P0['message']
+    is(message, "get_integer() not implemented in class 'Capture'", 'get_integer_not_implemented')
+
+end:
 .end
-CODE
-2
-2
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', 'list method delegation' );
-.sub main :main
-    $P0 = subclass 'Capture', 'Match'
-    addattribute $P0, '$.abc'
-    addattribute $P0, '$.xyz'
-    $P1 = new ['Match']
-    $P1[1] = 1
+.sub get_number_not_implemented
+    .local pmc capt, eh
+    .local num nval
 
-    $P2 = new ['String']
-    setattribute $P1, '$.abc', $P2
-    $P2 = new ['String']
-    setattribute $P1, '$.xyz', $P2
+    eh = new ['ExceptionHandler']
+#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED)
+    set_addr eh, eh_label
 
-    $P2 = $P1.'list'()
-    $P2 = 0
-    $I0 = elements $P2
-    print $I0
-    print "\n"
+    capt = new ['Capture']
+
+    push_eh eh
+      nval = capt
+    pop_eh
+
+    ok(0, 'get_number_not_implemented')
+    goto end
+
+eh_label:
+    .local string message
+    .get_results($P0)
+    message = $P0['message']
+    is(message, "get_number() not implemented in class 'Capture'", 'get_number_not_implemented')
+
+end:
 .end
-CODE
-0
-OUTPUT
 
+.sub keyed_int_delegation
+    .local pmc capt, foo, bar, baz
+    .local int ival
+
+    foo = subclass 'Capture', 'Match'
+    bar = new ['Match']
+    bar[1] = 1
+    ival = elements bar
+    is(ival, 2, 'first keyed_int_delegation test correct')
+
+    foo = subclass 'Match', 'Exp'
+    baz = new ['Exp']
+    baz[1] = 1
+    ival = elements baz
+    is(ival, 2, 'second keyed_int_delegation test correct')
+.end
+
+.sub list_method_delegation
+    .local pmc capt, foo, bar, baz
+    .local int ival
+
+    foo = subclass 'Capture', 'Match2'
+    addattribute foo, '$.abc'
+    addattribute foo, '$.xyz'
+    bar = new ['Match2']
+    bar[1] = 1
+
+    baz = new ['String']
+    setattribute bar, '$.abc', baz
+    baz = new ['String']
+    setattribute bar, '$.xyz', baz
+
+    baz = bar.'list'()
+    baz = 0
+    ival = elements baz
+    is(ival, 0, 'list_method_delegation test correct')
+.end
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4