This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
glob crashes when %File::Glob:: is empty
authorFather Chrysostomos <sprout@cpan.org>
Mon, 7 Jun 2010 10:07:11 +0000 (12:07 +0200)
committerRafael Garcia-Suarez <rgs@consttype.org>
Mon, 7 Jun 2010 10:07:11 +0000 (12:07 +0200)
In 5.6.2, a failure to find a CORE::GLOBAL::glob after loading
File::Glob would result in a fallback to external glob via pp_glob.
Now it crashes.

The attached patch should fix this.

op.c
t/op/glob.t

diff --git a/op.c b/op.c
index f667164..c50111c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7167,11 +7167,12 @@ Perl_ck_glob(pTHX_ OP *o)
        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                newSVpvs("File::Glob"), NULL, NULL, NULL);
        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                newSVpvs("File::Glob"), NULL, NULL, NULL);
-       gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
-       glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV);
-       GvCV(gv) = GvCV(glob_gv);
-       SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
-       GvIMPORTED_CV_on(gv);
+       if((glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV))) {
+           gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
+           GvCV(gv) = GvCV(glob_gv);
+           SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
+           GvIMPORTED_CV_on(gv);
+       }
        LEAVE;
     }
 #endif /* PERL_EXTERNAL_GLOB */
        LEAVE;
     }
 #endif /* PERL_EXTERNAL_GLOB */
index 7a42f12..f8725f8 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require 'test.pl';
 }
 
 require 'test.pl';
-plan( tests => 15 );
+plan( tests => 16 );
 
 @oops = @ops = <op/*>;
 
 
 @oops = @ops = <op/*>;
 
@@ -51,7 +51,15 @@ for (1..2) {
     undef %File::Glob::;
     ++$i;
 }
     undef %File::Glob::;
     ++$i;
 }
-cmp_ok($i,'==',2,'remore File::Glob stash');
+cmp_ok($i,'==',2,'remove File::Glob stash');
+
+# a more sinister version of the same test (crashes from 5.8 to 5.13.1)
+{
+    undef %File::Glob::;
+    local %CORE::GLOBAL::;
+    eval "<.>";
+    ok(!length($@),"remove File::Glob stash *and* CORE::GLOBAL::glob");
+}
 
 # ... while ($var = glob(...)) should test definedness not truth
 
 
 # ... while ($var = glob(...)) should test definedness not truth