| Subject: | Coercions don't allow for subclassing an other problems |
I discovered that the coercions did not allow for overriding in a subclass without redefining the coercions in the subclass as well. That doesn't seem right. My expectation was that the coercions would apply to the method name (so the method named as_string would be the STRINGIFYer) and not to that particular implementation of the method.
This patch fixes that as well as another problem I came across where you could use the coercion attributes in subclass that did not "use Class::Std", but the code would die at runtime with an odd error about unable to find method ident (I don't have the exact wording right now).
Also in the patch:
* a line in the pod-coverage.t test to get rid of the warning about too late for CHECK block.
* removal of dependency on List::Util. The fix for the coercions removed that dep and so I made sure that is wasn't listed anymore.
Andrew Parker
diff -uNr Class-Std-0.0.2-orig/Build.PL Class-Std-0.0.2-fix-overload/Build.PL
--- Class-Std-0.0.2-orig/Build.PL Wed May 25 15:26:58 2005
+++ Class-Std-0.0.2-fix-overload/Build.PL Sat Aug 6 00:24:02 2005
@@ -11,7 +11,6 @@
'Test::More' => 0,
'version' => 0,
'Scalar::Util' => 0,
- 'List::Util' => 0,
'Data::Dumper' => 0,
},
add_to_cleanup => [ 'Class-Std-*' ],
diff -uNr Class-Std-0.0.2-orig/META.yml Class-Std-0.0.2-fix-overload/META.yml
--- Class-Std-0.0.2-orig/META.yml Wed May 25 15:29:29 2005
+++ Class-Std-0.0.2-fix-overload/META.yml Sat Aug 6 00:24:19 2005
@@ -6,7 +6,6 @@
installdirs: site
requires:
Data::Dumper: 0
- List::Util: 0
Scalar::Util: 0
Test::More: 0
version: 0
diff -uNr Class-Std-0.0.2-orig/Makefile.PL Class-Std-0.0.2-fix-overload/Makefile.PL
--- Class-Std-0.0.2-orig/Makefile.PL Wed May 25 15:27:03 2005
+++ Class-Std-0.0.2-fix-overload/Makefile.PL Sat Aug 6 00:24:33 2005
@@ -12,7 +12,6 @@
'Test::More' => 0,
'version' => 0,
'Scalar::Util' => 0,
- 'List::Util' => 0,
'Data::Dumper' => 0,
},
diff -uNr Class-Std-0.0.2-orig/lib/Class/Std.pm Class-Std-0.0.2-fix-overload/lib/Class/Std.pm
--- Class-Std-0.0.2-orig/lib/Class/Std.pm Wed May 25 15:29:20 2005
+++ Class-Std-0.0.2-fix-overload/lib/Class/Std.pm Sat Aug 6 00:23:50 2005
@@ -129,7 +129,7 @@
my $STD_OVERLOADER
= q{ package %%s;
use overload (
- q{%s} => sub { $_[0]->$referent(ident $_[0]) },
+ q{%s} => sub { $_[0]->$method($_[0]->ident()) },
fallback => 1
);
};
@@ -144,27 +144,23 @@
GLOBIFY => sprintf( $STD_OVERLOADER, q{*{}} ),
CODIFY => sprintf( $STD_OVERLOADER, q{&{}} ),
);
+my %overload;
-use List::Util qw( first );
use Scalar::Util;
sub MODIFY_CODE_ATTRIBUTES {
my ($package, $referent, @attrs) = @_;
for my $attr (@attrs) {
if ($attr eq 'CUMULATIVE') {
- undef $attr;
push @{$cumulative{$package}}, $referent;
}
elsif ($attr =~ m/\A CUMULATIVE \s* [(] \s* BASE \s* FIRST \s* [)] \z/xms) {
- undef $attr;
push @{$anticumulative{$package}}, $referent;
}
- elsif (first {$attr eq $_} keys %OVERLOADER_FOR) {
- local $^W;
- eval sprintf $OVERLOADER_FOR{$attr}, ($package)x2;
- die "Internal error: $@" if $@;
- undef $attr;
+ elsif (exists $OVERLOADER_FOR{$attr}) {
+ push @{$overload{$package}}, [$referent, $attr];
}
+ undef $attr;
}
return grep {defined} @attrs;
}
@@ -298,6 +294,17 @@
};
}
}
+
+ for my $package (keys %overload) {
+ foreach my $operation (@{ $overload{$package} }) {
+ my ($referent, $attr) = @$operation;
+ local $^W;
+ my $method = _find_sub($package, $referent);
+ eval sprintf $OVERLOADER_FOR{$attr}, ($package)x2;
+ die "Internal error: $@" if $@;
+ }
+ delete $overload{$package};
+ }
}
sub new {
@@ -1891,10 +1898,6 @@
=item *
Scalar::Util
-
-=item *
-
-List::Util
=item *
diff -uNr Class-Std-0.0.2-orig/t/coercions.t Class-Std-0.0.2-fix-overload/t/coercions.t
--- Class-Std-0.0.2-orig/t/coercions.t Sat May 14 18:46:52 2005
+++ Class-Std-0.0.2-fix-overload/t/coercions.t Fri Aug 5 23:56:50 2005
@@ -43,6 +43,51 @@
sub as_scalar : SCALARIFY { return \$global_scalar2 }
}
+# Test inheritance with change and they didn't "use Class::Std"
+package DerClass3;
+use base qw( BaseClass );
+{
+ sub as_str : STRINGIFY { return 'goodbye world' }
+ sub as_num : NUMERIFY { return 86 }
+ sub as_bool : BOOLIFY { return 1 }
+
+ sub as_code : CODIFY { return \&::global_sub2 }
+ sub as_glob : GLOBIFY { return \*::global_glob2 }
+ sub as_hash : HASHIFY { return \%global_hash2 }
+ sub as_array : ARRAYIFY { return \@global_array2 }
+ sub as_scalar : SCALARIFY { return \$global_scalar2 }
+}
+
+# Test inheritance with change and they don't re-specify the coercions
+package DerClass4;
+use base qw( BaseClass );
+{
+ sub as_str { return 'goodbye world' }
+ sub as_num { return 86 }
+ sub as_bool { return 1 }
+
+ sub as_code { return \&::global_sub2 }
+ sub as_glob { return \*::global_glob2 }
+ sub as_hash { return \%global_hash2 }
+ sub as_array { return \@global_array2 }
+ sub as_scalar { return \$global_scalar2 }
+}
+
+# Test inheritance with changing the subs used for the coercions
+package DerClass5;
+use base qw( BaseClass );
+{
+ sub as_str_changed : STRINGIFY { return 'goodbye world' }
+ sub as_num_changed : NUMERIFY { return 86 }
+ sub as_bool_changed : BOOLIFY { return 1 }
+
+ sub as_code_changed : CODIFY { return \&::global_sub2 }
+ sub as_glob_changed : GLOBIFY { return \*::global_glob2 }
+ sub as_hash_changed : HASHIFY { return \%global_hash2 }
+ sub as_array_changed : ARRAYIFY { return \@global_array2 }
+ sub as_scalar_changed : SCALARIFY { return \$global_scalar2 }
+}
+
package main;
@@ -94,3 +139,48 @@
is \@{$obj}, \@global_array2 => 'Der2 Array coercion';
is \${$obj}, \$global_scalar2 => 'Der2 Scalar coercion';
+
+# Redefining coercions on inheritance and there is no "use Class::Std"
+# in the subclass
+
+$obj = DerClass3->new();
+
+ok $obj => 'Der3 Boolean coercion';
+is 0+$obj, 86 => 'Der3 Numeric coercion';
+is "$obj", 'goodbye world' => 'Der3 String coercion';
+
+is \&{$obj}, \&global_sub2 => 'Der3 Code coercion';
+is \*{$obj}, \*global_glob2 => 'Der3 Glob coercion';
+is \%{$obj}, \%global_hash2 => 'Der3 Hash coercion';
+is \@{$obj}, \@global_array2 => 'Der3 Array coercion';
+is \${$obj}, \$global_scalar2 => 'Der3 Scalar coercion';
+
+
+# The subclass doesn't need to specify the coercions again
+
+$obj = DerClass4->new();
+
+ok $obj => 'Der4 Boolean coercion';
+is 0+$obj, 86 => 'Der4 Numeric coercion';
+is "$obj", 'goodbye world' => 'Der4 String coercion';
+
+is \&{$obj}, \&global_sub2 => 'Der4 Code coercion';
+is \*{$obj}, \*global_glob2 => 'Der4 Glob coercion';
+is \%{$obj}, \%global_hash2 => 'Der4 Hash coercion';
+is \@{$obj}, \@global_array2 => 'Der4 Array coercion';
+is \${$obj}, \$global_scalar2 => 'Der4 Scalar coercion';
+
+
+# The subclass doesn't need to specify the coercions again
+
+$obj = DerClass5->new();
+
+ok $obj => 'Der5 Boolean coercion';
+is 0+$obj, 86 => 'Der5 Numeric coercion';
+is "$obj", 'goodbye world' => 'Der5 String coercion';
+
+is \&{$obj}, \&global_sub2 => 'Der5 Code coercion';
+is \*{$obj}, \*global_glob2 => 'Der5 Glob coercion';
+is \%{$obj}, \%global_hash2 => 'Der5 Hash coercion';
+is \@{$obj}, \@global_array2 => 'Der5 Array coercion';
+is \${$obj}, \$global_scalar2 => 'Der5 Scalar coercion';
diff -uNr Class-Std-0.0.2-orig/t/pod-coverage.t Class-Std-0.0.2-fix-overload/t/pod-coverage.t
--- Class-Std-0.0.2-orig/t/pod-coverage.t Wed May 18 22:03:41 2005
+++ Class-Std-0.0.2-fix-overload/t/pod-coverage.t Sat Aug 6 00:02:30 2005
@@ -3,6 +3,7 @@
use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+use Class::Std;
all_pod_coverage_ok(
{ also_private => [ qr/^[A-Z_]+$|^uniq$/ ], },
);