diff --git t/library/protoobject.t t/library/protoobject.t index c9c6315..05e8c53 100644 --- t/library/protoobject.t +++ t/library/protoobject.t @@ -1,13 +1,7 @@ -#!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,20 +16,30 @@ This test exercises the protoobject/Protomaker implementations. =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,45 +47,33 @@ pir_output_is( << 'END_CODE', << 'END_OUT', 'type of protoobject' ); $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,51 +82,38 @@ pir_output_is( << 'END_CODE', << 'END_OUT', 'Protoobject symbol' ); $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,40 +131,29 @@ pir_output_is( <<'END_CODE', <<'END_OUT', 'new_subclass with attrs' ); $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: