Ticket #1312: library_protoobject_t.patch

t/library/protoobject.t

@@ -1 @@
-#!perl
+#!parrot
 # Copyright (C) 2001-2005, Parrot Foundation.
 # $Id$
 
-use strict;
-use warnings;
-use lib qw( t . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 9;
-
 =head1 NAME
 
 t/library/protoobject.t - testing Protoobject.pir
@@ -22 +16 @@
 
 =cut
 
-pir_output_is( << 'END_CODE', << 'END_OUT', 'basic load' );
 .sub main :main
+    .include 'test_more.pir'
+    plan(13)
+
+    test_basic_load()
+    test_type_of_protoobject()
+    test_type_of_ns_based_protoobject()
+    test_protoobject_symbol_1()
+    test_protoobject_symbol_2()
+    test_protoobject_symbol_for_classes()
+    test_new_subclass_for_classes()
+    test_new_subclass_with_attrs()
+    test_method_new_on_protoobject()
+.end
+
+.sub test_basic_load
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
     $S0 = typeof $P0
-    say $S0
+    is($S0, 'Protomaker', 'basic load')
 .end
-END_CODE
-Protomaker
-END_OUT
 
-pir_output_is( << 'END_CODE', << 'END_OUT', 'type of protoobject' );
-.sub main :main
+.sub test_type_of_protoobject
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
@@ -43 +47 @@
     $P2 = $P0.'new_proto'($P1)
 
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'XYZ', 'type of protoobject')
 .end
-END_CODE
-XYZ
-END_OUT
 
-pir_output_is( << 'END_CODE', << 'END_OUT', 'type of ns-based protoobject' );
-.sub main :main
+.sub test_type_of_ns_based_protoobject
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
-    $P1 = newclass ['Foo';'Bar']
+    $P1 = newclass ['Foo';'Bar1']
     $P2 = $P0.'new_proto'($P1)
 
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo;Bar1', 'type of ns-based protoobject')
 .end
-END_CODE
-Foo;Bar
-END_OUT
 
-pir_output_is( << 'END_CODE', << 'END_OUT', 'Protoobject symbol' );
-.sub main :main
+.sub test_protoobject_symbol_1
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
-    $P1 = newclass ['Foo';'Bar']
+    $P1 = newclass ['Foo';'Bar2']
     $P2 = $P0.'new_proto'($P1)
 
-    $P2 = get_hll_global ['Foo'], 'Bar'
+    $P2 = get_hll_global ['Foo'], 'Bar2'
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo;Bar2', 'protoobject symbol 1')
 .end
-END_CODE
-Foo;Bar
-END_OUT
 
-pir_output_is( << 'END_CODE', << 'END_OUT', 'Protoobject symbol' );
-.sub main :main
+.sub test_protoobject_symbol_2
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
@@ -90 +82 @@
 
     $P2 = get_hll_global 'Foo'
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo', 'protoobject symbol 2')
 .end
-END_CODE
-Foo
-END_OUT
 
-pir_output_is( <<'END_CODE', <<'END_OUT', 'Protoobject symbol for :: classes' );
-.sub main :main
+.sub test_protoobject_symbol_for_classes
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
-    $P1 = newclass 'Foo::Bar'
+    $P1 = newclass 'Foo::Bar3'
     $P2 = $P0.'new_proto'($P1)
 
-    $P2 = get_hll_global ['Foo'], 'Bar'
+    $P2 = get_hll_global ['Foo'], 'Bar3'
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo::Bar3', 'protoobject symbol for :: classes')
 .end
-END_CODE
-Foo::Bar
-END_OUT
 
-pir_output_is( <<'END_CODE', <<'END_OUT', 'new_subclass for :: classes' );
-.sub main :main
+.sub test_new_subclass_for_classes
     load_bytecode 'Protoobject.pbc'
 
     $P0 = get_hll_global 'Protomaker'
     $P1 = get_class 'Hash'
-    $P0.'new_subclass'($P1, 'Foo::Bar')
+    $P0.'new_subclass'($P1, 'Foo::Bar4')
 
-    $P2 = new 'Foo::Bar'
+    $P2 = new 'Foo::Bar4'
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo::Bar4', 'new_subclass for :: classes')
 
-    $P2 = get_hll_global ['Foo'], 'Bar'
+    $P2 = get_hll_global ['Foo'], 'Bar4'
     $S0 = typeof $P2
-    say $S0
+    is($S0, 'Foo::Bar4', 'new_subclass for :: classes')
 .end
-END_CODE
-Foo::Bar
-Foo::Bar
-END_OUT
 
-pir_output_is( <<'END_CODE', <<'END_OUT', 'new_subclass with attrs' );
-.sub main :main
+.sub test_new_subclass_with_attrs
     load_bytecode 'Protoobject.pbc'
 
     .local pmc protomaker, hashclass, attrs
@@ -152 +131 @@
     $S0 = $P0
     setattribute object, $S0, $P0
     $P1 = getattribute object, $S0
-    say $P1
+    is($P1, $P0,'new_subclass with attrs')
     goto iter_loop
   iter_end:
 .end
-END_CODE
-$a
-$b
-$c
-$d
-END_OUT
-
-pir_output_is( <<'END_CODE', <<'END_OUT', 'method "new" on protoobject' );
-.sub main :main
+
+.sub test_method_new_on_protoobject
     load_bytecode 'Protoobject.pbc'
 
-    $P0 = newclass 'Foo'
+    $P0 = newclass 'Foo1'
 
     .local pmc protomaker
     protomaker = get_hll_global 'Protomaker'
-    protomaker.'new_proto'('Foo')
+    protomaker.'new_proto'('Foo1')
 
-    $P0 = get_hll_global 'Foo'
+    $P0 = get_hll_global 'Foo1'
     $P1 = $P0.'new'()
     $S0 = typeof $P1
-    say $S0
+    is($S0, 'Foo1', 'method "new" on protoobject')
 .end
-END_CODE
-Foo
-END_OUT
 
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4
 #   fill-column: 100
 # End:
-# vim: expandtab shiftwidth=4:
-
+# vim: expandtab shiftwidth=4 filetype=pir: