From Damian: Class::Struct was unable to define

recursive classes.  After the patch an object reference
(rather than a hash) is required to initialize
an object attribute.  If no such initializer is given to
the constructor, object attributes are now default
initialized to C<undef>.

p4raw-id: //depot/perl@11877

2 files changed, 40 insertions, 14 deletions

diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
index 5c68bf34d3..4685bd1cef 100644
--- a/lib/Class/Struct.pm
+++ b/lib/Class/Struct.pm
@@ -14,7 +14,7 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(struct);
 
-$VERSION = '0.60';
+$VERSION = '0.61';
 
 ## Tested on 5.002 and 5.003 without class membership tests:
 my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
@@ -163,10 +163,10 @@ sub struct {
             $out .= "    \$r->$elem = $init undef;$cmt\n";
         }
         elsif( $type =~ /^\w+(?:::\w+)*$/ ){
-            $init = "defined(\$init{'$name'}) ? \%{\$init{'$name'}} : ()";
-            $out .= "    croak 'Initializer for $name must be hash reference'\n";
-            $out .= "        if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
-            $out .= "    \$r->$elem = '${type}'->new($init);$cmt\n";
+            $init = "defined(\$init{'$name'}) ? \$init{'$name'} : undef";
+            $out .= "    croak 'Initializer for $name must be $type reference'\n";
+            $out .= "        if defined(\$init{'$name'}) && !UNIVERSAL::isa(\$init{'$name'}, '$type');\n";
+            $out .= "    \$r->$elem = $init;$cmt\n";
             $classes{$name} = $type;
             $got_class = 1;
         }
@@ -440,8 +440,8 @@ The initializer value for a scalar element is just a scalar value. The
 initializer for an array element is an array reference. The initializer
 for a hash is a hash reference.
 
-The initializer for a class element is also a hash reference, and the
-contents of that hash are passed to the element's own constructor.
+The initializer for a class element is an object of the corresponding class,
+(or of one of its subclasses).
 
 See Example 3 below for an example of initialization.
 
@@ -545,7 +545,7 @@ struct's constructor.
     my $cat = Cat->new( name     => 'Socks',
                         kittens  => ['Monica', 'Kenneth'],
                         markings => { socks=>1, blaze=>"white" },
-                        breed    => { name=>'short-hair', cross=>1 },
+                        breed    => Breed->new(name=>'short-hair', cross=>1),
                       );
 
     print "Once a cat called ", $cat->name, "\n";
@@ -556,6 +556,19 @@ struct's constructor.
 
 =head1 Author and Modification History
 
+Modified by Damian Conway, 2001-09-04, v0.61.
+
+   Removed implicit construction of nested objects.
+   This helpfulness was fraught with problems:
+       * the class's constructor might not be called 'new'
+       * the class might not have a no-argument constructor
+       * "recursive" data structures don't work well:
+                 package Person;
+                 struct { mother => 'Person', father => 'Person'};
+   It is now necessary to pass an object reference to initialize a
+   nested object.
+
+
 Modified by Casey West, 2000-11-08, v0.59.
 
     Added the ability for compile time class creation.
diff --git a/lib/Class/Struct.t b/lib/Class/Struct.t
index 2dfaf85e6d..914132c776 100644
--- a/lib/Class/Struct.t
+++ b/lib/Class/Struct.t
@@ -5,7 +5,7 @@ BEGIN {
 	@INC = '../lib';
 }
 
-print "1..10\n";
+print "1..12\n";
 
 package aClass;
 
@@ -13,6 +13,10 @@ sub new { bless {}, shift }
 
 sub meth { 42 }
 
+package RecClass;
+
+sub new { bless {}, shift }
+
 package MyObj;
 
 use Class::Struct;
@@ -51,26 +55,35 @@ print "ok 5\n";
 
 my $orf = $obj->c;
 
-print "not " unless ref $orf eq 'aClass';
+print "not " if defined($orf);
 print "ok 6\n";
 
-print "not " unless $obj->c->meth() == 42;
+$obj = MyObj->new( c => aClass->new );
+$orf = $obj->c;
+
+print "not " if ref $orf ne 'aClass';
 print "ok 7\n";
 
+print "not " unless $obj->c->meth() == 42;
+print "ok 8\n";
+
 my $obk = SomeClass->new();
 
 $obk->SomeElem(123);
 
 print "not " unless $obk->SomeElem() == 123;
-print "ok 8\n";
+print "ok 9\n";
 
 $obj->a([4,5,6]);
 
 print "not " unless $obj->a(1) == 5;
-print "ok 9\n";
+print "ok 10\n";
 
 $obj->h({h=>7,r=>8,f=>9});
 
 print "not " unless $obj->h('r') == 8;
-print "ok 10\n";
+print "ok 11\n";
+
+my $recobj = RecClass->new() or print "not ";
+print "ok 12\n";