Change 11877 by jhi@alpha on 2001/09/05 12:07:53
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>.
Affected files ...
... //depot/perl/lib/Class/Struct.pm#21 edit
... //depot/perl/lib/Class/Struct.t#2 edit
Differences ...
==== //depot/perl/lib/Class/Struct.pm#21 (text) ====
Index: perl/lib/Class/Struct.pm
--- perl/lib/Class/Struct.pm.~1~ Wed Sep 5 06:15:05 2001
+++ perl/lib/Class/Struct.pm Wed Sep 5 06:15:05 2001
@@ -14,7 +14,7 @@
@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 @@
$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 @@
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 @@
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 @@
=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.
==== //depot/perl/lib/Class/Struct.t#2 (text) ====
Index: perl/lib/Class/Struct.t
--- perl/lib/Class/Struct.t.~1~ Wed Sep 5 06:15:05 2001
+++ perl/lib/Class/Struct.t Wed Sep 5 06:15:05 2001
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..10\n";
+print "1..12\n";
package aClass;
@@ -13,6 +13,10 @@
sub meth { 42 }
+package RecClass;
+
+sub new { bless {}, shift }
+
package MyObj;
use Class::Struct;
@@ -51,26 +55,35 @@
my $orf = $obj->c;
-print "not " unless ref $orf eq 'aClass';
+print "not " if defined($orf);
print "ok 6\n";
+$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 7\n";
+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";
End of Patch.
