mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
Fix assorted bugs related to not having a UNIVERSAL::import
Since perl 5.0 the methods "import" and "unimport" have been
special cased in gv.c (unimport was removed for a while) to
not produce errors if they are called. This is partly
because
use Foo;
is defined to be
BEGIN {
require Foo;
Foo->import();
}
which would blow up if there is no import function defined in
Foo, for instance if it were defining a class and not a package
which exports modules.
This special case can be broken by simple code like
\&UNIVERSAL::isa
which will create a stub function which then blows up when it is
used. Notably the module "autouse" which is shipped with perl will
trigger this behavior.
A related issue is that if you ask for a function to be exported
from a module that does not have support for exporting there is no
error, eg:
use File::Spec qw(catfile);
will silently succeed without exporting a catfile function. This is
exacerbated on case insensitive file systems when the module name
is case-mismatched, the use succeeds but the export does not, leading
to confusion, eg:
use LIst::Util qw(sum); # note the typo!
will load List::Util but will not export the sum function.
This patch defines UNIVERSAL::import() and UNIVERSAL::unimport()
functions. This prevents the "reference to \&UNIVERSAL::import" bug.
The function is defined to be a no-op unless arguments are passed into
the functions, in which case a warning is thrown indicating
that there is likely a problem. The error is modelled after the
error produced by calling a non-existent method or function:
./perl -Ilib -le'BEGIN{ my $import_sub= \&UNIVERSAL::import;}
use File::Spec qw(catfile);'
Attempt to call UNIVERSAL::import() with arguments via package File::Spec
(Perhaps you forgot to load "File::Spec"?) at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
This fixes Issue #19416, Issue #19417, Issue #19418. See also Issue #19410 for
discussion, however this patch does not fix that case (it may not be
fixable.)
This commit is contained in:
parent
7c1600f081
commit
2dcf3cf50d
8
gv.c
8
gv.c
@ -1212,13 +1212,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
|
||||
gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
|
||||
if (!gv) {
|
||||
/* This is the special case that exempts Foo->import and
|
||||
Foo->unimport from being an error even if there's no
|
||||
import/unimport subroutine */
|
||||
if (strEQ(name,"import") || strEQ(name,"unimport")) {
|
||||
gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL,
|
||||
NULL, 0, 0, NULL));
|
||||
} else if (autoload)
|
||||
if (autoload)
|
||||
gv = gv_autoload_pvn(
|
||||
ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
|
||||
);
|
||||
|
||||
@ -1,19 +1,9 @@
|
||||
package UNIVERSAL;
|
||||
|
||||
our $VERSION = '1.15';
|
||||
our $VERSION = '1.16';
|
||||
|
||||
# UNIVERSAL should not contain any extra subs/methods beyond those
|
||||
# that it exists to define. The existence of import() below is a historical
|
||||
# accident that can't be fixed without breaking code.
|
||||
|
||||
# Make sure that even though the import method is called, it doesn't do
|
||||
# anything unless called on UNIVERSAL.
|
||||
sub import {
|
||||
return unless $_[0] eq __PACKAGE__;
|
||||
return unless @_ > 1;
|
||||
require Carp;
|
||||
Carp::croak("UNIVERSAL does not export anything");
|
||||
}
|
||||
# UNIVERSAL.pm should not contain any methods/subs, they
|
||||
# are all defined in universal.c
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
@ -1256,6 +1256,14 @@ a string overload and is also not a blessed CODE reference. In short the
|
||||
C<require> function does not know what to do with the object.
|
||||
See also L<perlfunc/require>.
|
||||
|
||||
=item Attempt to call undefined %s method with arguments via package
|
||||
"%s" (perhaps you forgot to load the package?)
|
||||
|
||||
(F) You called the C<import()> or C<unimport()> method of a class that
|
||||
has no import method defined in its inheritance graph. This is very
|
||||
often the sign of a mispelled package name in a use or require statement
|
||||
that has silently succeded due to a case insensitive file system.
|
||||
|
||||
=item Can't locate package %s for @%s::ISA
|
||||
|
||||
(W syntax) The @ISA array contained the name of another package that
|
||||
|
||||
@ -139,9 +139,9 @@ like $@, qr/^Invalid version format/;
|
||||
|
||||
my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
|
||||
if ('a' lt 'A') {
|
||||
is $subs, "can isa DOES VERSION";
|
||||
is $subs, "can import isa unimport DOES VERSION";
|
||||
} else {
|
||||
is $subs, "DOES VERSION can isa";
|
||||
is $subs, "DOES VERSION can import isa unimport";
|
||||
}
|
||||
|
||||
ok $a->isa("UNIVERSAL");
|
||||
@ -160,11 +160,10 @@ eval "use UNIVERSAL";
|
||||
ok $a->isa("UNIVERSAL");
|
||||
|
||||
my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
|
||||
# XXX import being here is really a bug
|
||||
if ('a' lt 'A') {
|
||||
is $sub2, "can import isa DOES VERSION";
|
||||
is $sub2, "can import isa unimport DOES VERSION";
|
||||
} else {
|
||||
is $sub2, "DOES VERSION can import isa";
|
||||
is $sub2, "DOES VERSION can import isa unimport";
|
||||
}
|
||||
|
||||
eval 'sub UNIVERSAL::sleep {}';
|
||||
@ -198,10 +197,12 @@ ok $x->isa('UNIVERSAL');
|
||||
ok $x->isa('UNIVERSAL');
|
||||
|
||||
|
||||
# Check that the "historical accident" of UNIVERSAL having an import()
|
||||
# method doesn't effect anyone else.
|
||||
eval { Some::Package->import("bar") };
|
||||
is $@, '';
|
||||
my $err= $@;
|
||||
$err=~s!t/op!op!;
|
||||
is $err, "Attempt to call undefined import method with arguments"
|
||||
. " via package \"Some::Package\" (Perhaps you forgot to load"
|
||||
. " the package?) at op/universal.t line 200.\n";
|
||||
|
||||
|
||||
# This segfaulted in a blead.
|
||||
|
||||
25
universal.c
25
universal.c
@ -454,6 +454,29 @@ XS(XS_UNIVERSAL_isa)
|
||||
}
|
||||
}
|
||||
|
||||
XS(XS_UNIVERSAL_import_unimport); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(XS_UNIVERSAL_import_unimport)
|
||||
{
|
||||
dXSARGS;
|
||||
dXSI32;
|
||||
|
||||
if (items > 1) {
|
||||
char *class_pv= SvPV_nolen(ST(0));
|
||||
if (strEQ(class_pv,"UNIVERSAL"))
|
||||
Perl_croak(aTHX_ "UNIVERSAL does not export anything");
|
||||
/* _charnames is special - ignore it for now as the code that
|
||||
* depends on it has its own "no import" logic that produces better
|
||||
* warnings than this does. */
|
||||
if (strNE(class_pv,"_charnames"))
|
||||
Perl_croak(aTHX_
|
||||
"Attempt to call undefined %s method with arguments via package "
|
||||
"%" SVf_QUOTEDPREFIX " (Perhaps you forgot to load the package?)",
|
||||
ix ? "unimport" : "import", SVfARG(ST(0)));
|
||||
}
|
||||
XSRETURN_EMPTY;
|
||||
}
|
||||
|
||||
|
||||
XS(XS_UNIVERSAL_can); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(XS_UNIVERSAL_can)
|
||||
{
|
||||
@ -1287,6 +1310,8 @@ static const struct xsub_details these_details[] = {
|
||||
{"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL, 0 },
|
||||
{"UNIVERSAL::can", XS_UNIVERSAL_can, NULL, 0 },
|
||||
{"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL, 0 },
|
||||
{"UNIVERSAL::import", XS_UNIVERSAL_import_unimport, NULL, 0},
|
||||
{"UNIVERSAL::unimport", XS_UNIVERSAL_import_unimport, NULL, 1},
|
||||
#define VXS_XSUB_DETAILS
|
||||
#include "vxs.inc"
|
||||
#undef VXS_XSUB_DETAILS
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user