summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Class
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
committerKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
commit300c1eb6d37d46078d448d6d58938d5a80cd68ff (patch)
tree23a0a8b9f8f5460b405119c4d3c163d2d488ca5e /Master/tlpkg/tlperl/lib/Class
parented55d86b7c5e18f6eccce80a1fb1423ca40a23b5 (diff)
(tl)perl 5.18.2 for windows from siep
git-svn-id: svn://tug.org/texlive/trunk@33648 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Class')
-rw-r--r--Master/tlpkg/tlperl/lib/Class/Struct.pm25
1 files changed, 12 insertions, 13 deletions
diff --git a/Master/tlpkg/tlperl/lib/Class/Struct.pm b/Master/tlpkg/tlperl/lib/Class/Struct.pm
index 7a9af54faf8..ecb623199fd 100644
--- a/Master/tlpkg/tlperl/lib/Class/Struct.pm
+++ b/Master/tlpkg/tlperl/lib/Class/Struct.pm
@@ -14,10 +14,7 @@ require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(struct);
-$VERSION = '0.63';
-
-## Tested on 5.002 and 5.003 without class membership tests:
-my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
+$VERSION = '0.64';
my $print = 0;
sub printem {
@@ -130,6 +127,9 @@ sub struct {
elsif( $base_type eq 'ARRAY' ){
$out .= " my(\$r) = [];\n";
}
+
+ $out .= " bless \$r, \$class;\n\n";
+
while( $idx < @decls ){
$name = $decls[$idx];
$type = $decls[$idx+1];
@@ -150,24 +150,24 @@ sub struct {
if( $type eq '@' ){
$out .= " croak 'Initializer for $name must be array reference'\n";
$out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
- $out .= " \$r->$elem = $init [];$cmt\n";
+ $out .= " \$r->$name( $init [] );$cmt\n";
$arrays{$name}++;
}
elsif( $type eq '%' ){
$out .= " croak 'Initializer for $name must be hash reference'\n";
$out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
- $out .= " \$r->$elem = $init {};$cmt\n";
+ $out .= " \$r->$name( $init {} );$cmt\n";
$hashes{$name}++;
}
elsif ( $type eq '$') {
- $out .= " \$r->$elem = $init undef;$cmt\n";
+ $out .= " \$r->$name( $init undef );$cmt\n";
}
elsif( $type =~ /^\w+(?:::\w+)*$/ ){
$out .= " if (defined(\$init{'$name'})) {\n";
$out .= " if (ref \$init{'$name'} eq 'HASH')\n";
- $out .= " { \$r->$elem = $type->new(\%{\$init{'$name'}}) } $cmt\n";
+ $out .= " { \$r->$name( $type->new(\%{\$init{'$name'}}) ) } $cmt\n";
$out .= " elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n";
- $out .= " { \$r->$elem = \$init{'$name'} } $cmt\n";
+ $out .= " { \$r->$name( \$init{'$name'} ) } $cmt\n";
$out .= " else { croak 'Initializer for $name must be hash or $type reference' }\n";
$out .= " }\n";
$classes{$name} = $type;
@@ -178,7 +178,8 @@ sub struct {
}
$idx += 2;
}
- $out .= " bless \$r, \$class;\n }\n";
+
+ $out .= "\n \$r;\n}\n";
# Create accessor methods.
@@ -216,9 +217,7 @@ sub struct {
$sel = "->{\$i}";
}
elsif( defined $classes{$name} ){
- if ( $CHECK_CLASS_MEMBERSHIP ) {
- $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
- }
+ $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
}
$out .= " croak 'Too many args to $name' if \@_ > 1;\n";
$out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";