This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl -d: add test for the x command.
[perl5.git] / lib / Class / Struct.t
index 2dfaf85..694d622 100644 (file)
@@ -5,72 +5,99 @@ BEGIN {
        @INC = '../lib';
 }
 
-print "1..10\n";
-
+#
+# A couple of simple classes to use as struct elements.
+#
 package aClass;
-
 sub new { bless {}, shift }
-
 sub meth { 42 }
 
-package MyObj;
+package RecClass;
+sub new { bless {}, shift }
 
+#
+# The first of our Class::Struct based objects.
+#
+package MyObj;
 use Class::Struct;
 use Class::Struct 'struct'; # test out both forms
-
 use Class::Struct SomeClass => { SomeElem => '$' };
 
 struct( s => '$', a => '@', h => '%', c => 'aClass' );
 
-my $obj = MyObj->new;
+#
+# The second Class::Struct objects:
+# test the 'compile-time without package name' feature.
+#
+package MyOther;
+use Class::Struct s => '$', a => '@', h => '%', c => 'aClass';
 
-$obj->s('foo');
+#
+# back to main...
+#
+package main;
 
-print "not " unless $obj->s() eq 'foo';
-print "ok 1\n";
+use Test::More tests => 24;
 
-my $arf = $obj->a;
+my $obj = MyObj->new;
+isa_ok $obj, 'MyObj';
 
-print "not " unless ref $arf eq 'ARRAY';
-print "ok 2\n";
+$obj->s('foo');
+is $obj->s(), 'foo';
 
+isa_ok $obj->a, 'ARRAY';
 $obj->a(2, 'secundus');
+is $obj->a(2), 'secundus';
 
-print "not " unless $obj->a(2) eq 'secundus';
-print "ok 3\n";
-
-my $hrf = $obj->h;
-
-print "not " unless ref $hrf eq 'HASH';
-print "ok 4\n";
+$obj->a([4,5,6]);
+is $obj->a(1), 5;
 
+isa_ok $obj->h, 'HASH';
 $obj->h('x', 10);
+is $obj->h('x'), 10;
 
-print "not " unless $obj->h('x') == 10;
-print "ok 5\n";
+$obj->h({h=>7,r=>8,f=>9});
+is $obj->h('r'), 8;
 
-my $orf = $obj->c;
+is $obj->c, undef;
 
-print "not " unless ref $orf eq 'aClass';
-print "ok 6\n";
+$obj = MyObj->new( c => aClass->new );
+isa_ok $obj->c, 'aClass';
+is $obj->c->meth(), 42;
 
-print "not " unless $obj->c->meth() == 42;
-print "ok 7\n";
 
-my $obk = SomeClass->new();
+$obj = MyOther->new;
+isa_ok $obj, 'MyOther';
 
-$obk->SomeElem(123);
+$obj->s('foo');
+is $obj->s(), 'foo';
 
-print "not " unless $obk->SomeElem() == 123;
-print "ok 8\n";
+isa_ok $obj->a, 'ARRAY';
+$obj->a(2, 'secundus');
+is $obj->a(2), 'secundus';
 
 $obj->a([4,5,6]);
+is $obj->a(1), 5;
 
-print "not " unless $obj->a(1) == 5;
-print "ok 9\n";
+isa_ok $obj->h, 'HASH';
+$obj->h('x', 10);
+is $obj->h('x'), 10;
 
 $obj->h({h=>7,r=>8,f=>9});
+is $obj->h('r'), 8;
+
+is $obj->c, undef;
+
+$obj = MyOther->new( c => aClass->new );
+isa_ok $obj->c, 'aClass';
+is $obj->c->meth(), 42;
+
+
+
+my $obk = SomeClass->new();
+$obk->SomeElem(123);
+is $obk->SomeElem(), 123;
 
-print "not " unless $obj->h('r') == 8;
-print "ok 10\n";
+my $recobj = RecClass->new();
+isa_ok $recobj, 'RecClass';