Subject: | [PATCH] Compatibility with constants and with CV-in-stash optimisation |
See the attached patch. As of perl 5.28, stash entries may be sub refs. Also, since perl 5.6 I believe, stashes have contained various different items. So the patch expands the code a bit to handle the different things that can show up.
Subject: | open_WiPWMszs.txt |
diff -rup MOP-0.12-0/lib/MOP/Internal/Util.pm MOP-0.12-1/lib/MOP/Internal/Util.pm
--- MOP-0.12-0/lib/MOP/Internal/Util.pm 2017-10-30 12:44:30.000000000 -0700
+++ MOP-0.12-1/lib/MOP/Internal/Util.pm 2017-11-23 19:00:38.000000000 -0800
@@ -157,15 +157,15 @@ sub DOES_GLOB_HAVE_NULL_CV {
Carp::confess('[ARGS] You must specify a GLOB')
unless $glob;
# NOTE:
- # If the glob eq -1 that means it may well be a null sub
- # this seems to be some kind of artifact of an optimization
- # perhaps, I really don't know, it is odd. It should not
- # need to be dealt with in XS, it seems to be a Perl language
- # level thing.
- # - SL
- return 1 if $glob eq '-1';
- # next lets see if we have a CODE slot ...
- if ( my $code = *{ $glob }{CODE} ) {
+ # The glob may be -1 or a string, which is perl’s way of optimizing
+ # null sub declarations like ‘sub foo;’ and ‘sub bar($);’.
+ return 1 if ref \$glob eq 'SCALAR' && defined $glob;
+ # We may have a reference to a scalar or array, which represents a con-
+ # stant, so is not a null sub.
+ return 0 if ref $glob and ref $glob ne 'CODE';
+ # next lets see if we have a CODE slot (or a code reference instead of
+ # a glob) ...
+ if ( my $code = ref $glob ? $glob : *{ $glob }{CODE} ) {
return Sub::Metadata::sub_body_type( $code ) eq 'UNDEF';
}
# if we had no CODE slot, it can't be a NULL CV ...
diff -rup MOP-0.12-0/lib/MOP/Role.pm MOP-0.12-1/lib/MOP/Role.pm
--- MOP-0.12-0/lib/MOP/Role.pm 2017-10-30 12:44:30.000000000 -0700
+++ MOP-0.12-1/lib/MOP/Role.pm 2017-11-23 19:02:19.000000000 -0800
@@ -299,7 +299,9 @@ sub add_required_method {
# and if we don't and we have a CODE slot, we
# need to die because this doesn't make sense
Carp::confess("[CONFLICT] Cannot add a required method ($name) when there is a regular method already there")
- if defined *{ $glob }{CODE};
+ if ref \$glob eq 'GLOB'
+ ? defined *{ $glob }{CODE}
+ : defined $glob;
}
# if we get here, then we