diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/Class/Struct.pm | 14 | ||||
| -rw-r--r-- | t/lib/class-struct.t | 69 |
3 files changed, 73 insertions, 11 deletions
@@ -1353,6 +1353,7 @@ t/lib/cgi-pretty.t See if CGI.pm works t/lib/cgi-request.t See if CGI.pm works t/lib/charnames.t See if character names work t/lib/checktree.t See if File::CheckTree works +t/lib/class-struct.t See if Class::Struct works t/lib/complex.t See if Math::Complex works t/lib/db-btree.t See if DB_File works t/lib/db-hash.t See if DB_File works diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm index cf98cd7a1c..14d28fa4ac 100644 --- a/lib/Class/Struct.pm +++ b/lib/Class/Struct.pm @@ -54,7 +54,7 @@ sub printem { sub import { my $self = shift; - if ( @_ ) { + if ( @_ % 2 == 0 ) { &struct; } else { $self->export_to_level( 1, $self, @EXPORT ); @@ -86,6 +86,7 @@ sub struct { $class = (caller())[0]; @decls = @_; } + _usage_error() if @decls % 2 == 1; # Ensure we are not, and will not be, a subclass. @@ -256,7 +257,6 @@ 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, ... }; - package Myobj; use Class::Struct; # declare struct with four types of elements: @@ -276,14 +276,13 @@ Class::Struct - declare struct-like datatypes as Perl classes # hash type accessor: $hash_ref = $obj->h; # reference to whole hash $hash_element_value = $obj->h('x'); # hash element value - $obj->h('x', 'new value'); # assign to hash element + $obj->h('x', 'new value'); # assign to hash element # class type accessor: $element_value = $obj->c; # object reference $obj->c->method(...); # call method of object $obj->c(new My_Other_Class); # assign a new object - =head1 DESCRIPTION C<Class::Struct> exports a single function, C<struct>. @@ -301,7 +300,6 @@ same name in the package. (See Example 2.) Each element's type can be scalar, array, hash, or class. - =head2 The C<struct()> function The C<struct> function has three forms of parameter-list. @@ -433,7 +431,6 @@ contents of that hash are passed to the element's own constructor. See Example 3 below for an example of initialization. - =head1 EXAMPLES =over @@ -467,7 +464,6 @@ type C<timeval>. $t->ru_stime->tv_secs(5); $t->ru_stime->tv_usecs(0); - =item Example 2 An accessor function can be redefined in order to provide @@ -515,7 +511,6 @@ Note that the initializer for a nested struct is specified as an anonymous hash of initializers, which is passed on to the nested struct's constructor. - use Class::Struct; struct Breed => @@ -547,7 +542,6 @@ struct's constructor. =head1 Author and Modification History - Modified by Casey Tweten, 2000-11-08, v0.59. Added the ability for compile time class creation. @@ -568,7 +562,6 @@ Modified by Damian Conway, 1999-03-05, v0.58. Previously these were returned as a reference to a reference to the element. - Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02. members() function removed. @@ -580,7 +573,6 @@ Renamed to C<Class::Struct> and modified by Jim Miner, 1997-04-02. Class name to struct() made optional. Diagnostic checks added. - Originally C<Class::Template> by Dean Roehrich. # Template.pm --- struct/member template builder diff --git a/t/lib/class-struct.t b/t/lib/class-struct.t new file mode 100644 index 0000000000..c875fb068f --- /dev/null +++ b/t/lib/class-struct.t @@ -0,0 +1,69 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +print "1..2\n"; + +package aClass; + +sub new { bless {}, shift } + +sub meth { 42 } + +package MyObj; + +use Class::Struct 'struct'; + +use Class::Struct SomeClass => { SomeElem => '$' }; + +struct( s => '$', a => '@', h => '%', c => 'aClass' ); + +my $obj = MyObj->new; + +$obj->s('foo'); + +print "not " unless $obj->s() eq 'foo'; +print "ok 1\n"; + +my $arf = $obj->a; + +print "not " unless ref $arf eq 'ARRAY'; +print "ok 2\n"; + +$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->h('x', 10); + +print "not " unless $obj->h('x') == 10; +print "ok 5\n"; + +my $orf = $obj->c; + +print "not " unless ref $orf eq 'aClass'; +print "ok 6\n"; + +print "not " unless $obj->c->meth() == 42; +print "ok 7\n"; + +my $obk = SomeClass->new(); + +$obk->SomeElem(123); + +print "not " unless $obk->SomeElem() == 123; +print "ok 8\n"; + + + + + |