Re: Class::Struct, simple patch, tests

Message-ID: <20021018212638.GB3764@soto.kasei.com>

p4raw-id: //depot/perl@18105

2 files changed, 62 insertions, 44 deletions

diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
index ec080a1526..7a9af54faf 100644
--- a/lib/Class/Struct.pm
+++ b/lib/Class/Struct.pm
@@ -61,7 +61,7 @@ sub import {
 	# do we ever export anything else than 'struct'...?
       $self->export_to_level( 1, $self, @_ );
     } else {
-      &struct;
+      goto &struct;
     }
 }
 
@@ -266,6 +266,10 @@ Class::Struct - declare struct-like datatypes as Perl classes
     use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ];
     use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... };
 
+    # declare struct at compile time, based on array, implicit class name:
+    package CLASS_NAME;
+    use Class::Struct ELEMENT_NAME => ELEMENT_TYPE, ... ;
+
     package Myobj;
     use Class::Struct;
             # declare struct with four types of elements:
diff --git a/lib/Class/Struct.t b/lib/Class/Struct.t
index 914132c776..ffb5094d8c 100644
--- a/lib/Class/Struct.t
+++ b/lib/Class/Struct.t
@@ -5,85 +5,99 @@ BEGIN {
 	@INC = '../lib';
 }
 
-print "1..12\n";
-
+#
+# A couple of simple classes to use as struct elements.
+#
 package aClass;
-
 sub new { bless {}, shift }
-
 sub meth { 42 }
 
 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";
-
-my $orf = $obj->c;
+$obj->h({h=>7,r=>8,f=>9});
+is $obj->h('r'), 8;
 
-print "not " if defined($orf);
-print "ok 6\n";
+is $obj->c, undef;
 
 $obj = MyObj->new( c => aClass->new );
-$orf = $obj->c;
-
-print "not " if ref $orf ne 'aClass';
-print "ok 7\n";
+isa_ok $obj->c, 'aClass';
+is $obj->c->meth(), 42;
 
-print "not " unless $obj->c->meth() == 42;
-print "ok 8\n";
 
-my $obk = SomeClass->new();
+my $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 9\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 10\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;
 
-print "not " unless $obj->h('r') == 8;
-print "ok 11\n";
+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;
 
-my $recobj = RecClass->new() or print "not ";
-print "ok 12\n";
+my $recobj = RecClass->new();
+isa_ok $recobj, 'RecClass';