# New Ticket Created by Bruce Stockwell
# Please include the string: [perl #60600]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=60600 >
rewrite of t/oo/ops.t to PIR.
ops.t | 265
++++++++++++++++++++++++++++++++----------------------------------
1 file changed, 130 insertions(+), 135 deletions(-)
--
V/r
Bruce
Index: t/oo/ops.t
===================================================================
--- t/oo/ops.t (revision 32667)
+++ t/oo/ops.t (working copy)
@@ -1,13 +1,7 @@
-#!perl
+#! parrot
# Copyright (C) 2007, The Perl Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 8;
-
=head1 NAME
t/oo/ops.t - test OO related ops
@@ -22,156 +16,169 @@
=cut
-pir_output_is( <<'CODE', <<'OUT', 'addrole_p_p' );
-.sub 'test' :main
+.sub main :main
+ .include 'test_more.pir'
+
+ plan(20)
+
+ op_addrole_p_p()
+ op_inspect_p_p()
+ op_inspect_p_p_s()
+ op_get_class_p_s()
+ op_get_class_p_p()
+ op_addattribute_p_s()
+ op_new_p_s()
+ op_can_i_p_s()
+
+.end
+
+.sub op_addrole_p_p
$P0 = new 'Role'
$P1 = new 'Class'
+
+try:
+ push_eh catch
addrole $P1, $P0
- print "ok 1 - addrole op executed\n"
+ $I0 = 1 #addrole w/ no exception. set register for ok
$P2 = $P1.'roles'()
- $I0 = elements $P2
- if $I0 == 1 goto ok_2
- print "not "
-ok_2:
- print "ok 2 - addrole op actually added the role\n"
+ $I1 = elements $P2
+ goto finally
+
+catch:
+ $I0 = 0 #set register for fail
+ $I1 = 0 #set register for fail
+
+finally:
+ pop_eh
+ ok ($I0, 'addrole op executed')
+ is ($I1, 1, 'role verified')
+
.end
-CODE
-ok 1 - addrole op executed
-ok 2 - addrole op actually added the role
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'inspect_p_p' );
-.sub 'test' :main
+.sub op_inspect_p_p
$P0 = new 'Class'
+try:
+ push_eh catch
$P1 = inspect $P0
- print "ok 1 - inspect_p_p op executed\n"
+ $I0 = 1 #inspect w/ no exception. set register for ok
+ $I1 = elements $P1
+ goto finally
- $I0 = elements $P1
- if $I0 == 7 goto ok_2
- print "not "
-ok_2:
- print "ok 2 - returned hash had correct number of elements\n"
+catch:
+ $I0 = 0 #inspect w/ exception. set register for fail
+
+finally:
+ pop_eh
+ ok ($I0, 'inspect op executed')
+ is ($I1, 7, 'inspect hash count verified')
+
.end
-CODE
-ok 1 - inspect_p_p op executed
-ok 2 - returned hash had correct number of elements
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'inspect_p_p_s' );
-.sub 'test' :main
+.sub op_inspect_p_p_s
$P0 = new 'Class'
$P0.'name'('foo')
$P0.'add_attribute'('a')
$P1 = inspect $P0, 'name'
- say $P1
- print "ok 1 - inspect_p_p_s with $3='name'\n"
+ is ($P1, 'foo', 'inpect_p_p_s with name')
$P1 = inspect $P0, 'flags'
$I0 = $P1
$I1 = 1 << 29 # flag 29 is PObj_is_class_FLAG
-
$I2 = $I0 & $I1
- if $I2 goto flags_ok
- print "not "
- flags_ok:
- print "ok 2 - inspect_p_p_s with $3='flags'\n"
+ ok ($I2, 'inspect_p_p_s with flags')
$P1 = inspect $P0, 'attributes'
$I0 = elements $P1
- if $I0 == 1 goto ok_2
- print "not "
-ok_2:
- print "ok 3 - inspect_p_p_s with $3='attributes'\n"
+ is ($I0, 1, 'inspect_p_p_s with attributes')
.end
-CODE
-foo
-ok 1 - inspect_p_p_s with $3='name'
-ok 2 - inspect_p_p_s with $3='flags'
-ok 3 - inspect_p_p_s with $3='attributes'
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'get_class_p_s' );
-.sub main :main
+.sub op_get_class_p_s
$P0 = new 'Hash'
$P4 = new 'String'
$P4 = 'Monkey'
$P0['name'] = $P4
$P1 = new 'Class', $P0
- print "ok 1 - created new class named Monkey\n"
+ $I0 = isa $P1 , 'Class'
- push_eh nok_2
+try:
+ push_eh catch
$P2 = get_class 'Monkey'
+ $I1 = isa $P2 , 'Class'
+ goto finally
+
+catch:
+ $I1 = 0 # get_class w/ exception. set flag for failure
+
+finally:
pop_eh
- goto ok_2
-nok_2:
- print "not "
-ok_2:
- print "ok 2 - get_class found a class\n"
+ unless null $P2 goto ok
+ $P2 = new 'Class' # help inspect('name') fail gracefully
+ok:
$P3 = $P2.'inspect'('name')
- print $P3
- print "\nok 3 - got name of found class\n"
+
+ ok ($I0, 'created new class named Monkey')
+ ok ($I1, 'get_class found a class')
+ is ($P3, 'Monkey', 'got name of found class')
.end
-CODE
-ok 1 - created new class named Monkey
-ok 2 - get_class found a class
-Monkey
-ok 3 - got name of found class
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'get_class_p_p' );
-.sub main :main
+.sub op_get_class_p_p
$P0 = new 'Hash'
$P4 = new 'String'
- $P4 = 'Monkey'
+ $P4 = 'Ape'
$P0['name'] = $P4
$P1 = new 'Class', $P0
- print "ok 1 - created new class named Monkey\n"
+ $I0 = isa $P1 , 'Class'
- push_eh nok_2
- $P2 = get_class [ 'Monkey' ]
+try:
+ push_eh catch
+ $P2 = get_class [ 'Ape' ]
+ $I1 = isa $P2 , 'Class'
+ goto finally
+
+catch:
+ $I1 = 0 # get_class w/ exception. set flag for failure
+
+finally:
pop_eh
- goto ok_2
-nok_2:
- print "not "
-ok_2:
- print "ok 2 - get_class with a Key found a class\n"
+ unless null $P2 goto ok
+ $P2 = new 'Class' # help inspect('name') fail gracefully
+ok:
$P3 = $P2.'inspect'('name')
- print $P3
- print "\nok 3 - got name of found class\n"
- push_eh nok_4
+ ok ($I0, 'created new class named Ape')
+ ok ($I1, 'get_class with a key found a class')
+ is ($P3, 'Ape', 'got name of found class')
+
+try_1:
+ push_eh catch_1
$P3 = get_namespace [ 'Monkey' ]
$P2 = get_class $P3
- pop_eh
- goto ok_4
-nok_4:
+ $I1 = isa $P2 , 'Class'
+ goto finally_1
+
+catch_1:
print "not "
-ok_4:
- print "ok 4 - get_class with a NameSpace found a class\n"
+finally_1:
+ pop_eh
+
+ unless null $P2 goto ok_1
+ $P2 = new 'Class' # help inspect('name') fail gracefully
+ok_1:
$P3 = $P2.'inspect'('name')
- print $P3
- print "\nok 5 - got name of found class\n"
+
+ ok ($I1, 'get_class with a namespace found a class')
+ is ($P3, 'Monkey', 'got name of found class')
.end
-CODE
-ok 1 - created new class named Monkey
-ok 2 - get_class with a Key found a class
-Monkey
-ok 3 - got name of found class
-ok 4 - get_class with a NameSpace found a class
-Monkey
-ok 5 - got name of found class
-OUT
-pir_error_output_like( <<'CODE', <<'OUT', 'addattribute_p_s' );
-.sub main :main
+.sub op_addattribute_p_s
$P0 = new 'Class'
addattribute $P0, 'foo'
@@ -182,22 +189,25 @@
setattribute $P1, 'foo', $P2
getattribute $P2, $P1, 'foo'
- print $P2
- print "\n"
$P0 = new 'Hash'
+try:
+ push_eh catch
addattribute $P0, 'oops'
- print "Not here!\n"
+ $I0 = 1 # add attribute success flag
+ goto finally
+
+catch:
+ $I0 = 0 # add attribute failure flag
+
+finally:
+ pop_eh
+ is ($P2, 100, 'reading assigned attribute')
+ nok ($I0,'attempt to add attribute to non-class')
+
.end
-CODE
-/100
-Cannot add attribute to non-class
-current instr\.: 'main'/
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'new_p_s works with string register arg' );
-.sub main :main
-# $P0 = newclass "Foo"
+.sub op_new_p_s
$P0 = newclass "Foo"
addattribute $P0, 'foo'
@@ -209,42 +219,27 @@
setattribute $P1, 'foo', $P2
getattribute $P2, $P1, 'foo'
- print $P2
- print "\n"
+ is ($P2, 100, 'reading assigned attribute')
.end
-CODE
-100
-OUT
-pir_output_is( <<'CODE', <<'OUT', 'can_i_p_s' );
-.sub main :main
- $P0 = newclass "Foo"
+.sub op_can_i_p_s
+ $P0 = newclass "Baz"
$P1 = new $P0
can $I0, $P1, "bar"
-
- if $I0 goto can_bar
- print "not "
- can_bar:
- print "ok 1\n"
-
- $P1.'bar'()
+ ok ($I0, 'PMC has method bar')
+ $I1 = $P1.'bar'()
+ ok ($I1, 'called bar method on PMC')
.end
-.namespace ["Foo"]
+.namespace ["Baz"]
.sub bar :method
- print "called bar\n"
+ .return (1)
.end
-CODE
-ok 1
-called bar
-OUT
-
# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
+# mode: pir
# fill-column: 100
# End:
-# vim: expandtab shiftwidth=4:
+# vim: expandtab shiftwidth=4 ft=pir:
