Stop ‘used once’ warnings from crashing on circularities

gv_check was only checking for stashes nested directly inside them-
selves (*foo:: = *foo::foo) and the main stash.

Other stash circularities would cause infinite recursion, blowing the
C stack and crashing.

diff --git a/embed.fnc b/embed.fnc
index 15f21ec..d139eb9 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -465,7 +465,7 @@ ApR |GV*    |gv_autoload_pv |NULLOK HV* stash|NN const char* namepv \
                                 |U32 flags
 ApR    |GV*    |gv_autoload_pvn        |NULLOK HV* stash|NN const char* name \
                                         |STRLEN len|U32 flags
-Ap     |void   |gv_check       |NN const HV* stash
+Ap     |void   |gv_check       |NN HV* stash
 Ap     |void   |gv_efullname   |NN SV* sv|NN const GV* gv
 Apmb   |void   |gv_efullname3  |NN SV* sv|NN const GV* gv|NULLOK const char* prefix
 Ap     |void   |gv_efullname4  |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain

diff --git a/gv.c b/gv.c
index f66c6ba..a7fdd99 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2074,7 +2074,7 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain
 }
 
 void
-Perl_gv_check(pTHX_ const HV *stash)
+Perl_gv_check(pTHX_ HV *stash)
 {
     dVAR;
     I32 i;
@@ -2085,13 +2085,16 @@ Perl_gv_check(pTHX_ const HV *stash)
        return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
+       /* SvIsCOW is unused on HVs, so we can use it to mark stashes we
+          are currently searching through recursively.  */
+       SvIsCOW_on(stash);
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
             GV *gv;
             HV *hv;
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
                (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
            {
-               if (hv != PL_defstash && hv != stash)
+               if (hv != PL_defstash && hv != stash && !SvIsCOW(hv))
                     gv_check(hv);              /* nested package */
            }
             else if ( *HeKEY(entry) != '_'
@@ -2112,6 +2115,7 @@ Perl_gv_check(pTHX_ const HV *stash)
                             HEKfARG(GvNAME_HEK(gv)));
            }
        }
+       SvIsCOW_off(stash);
     }
 }
 

diff --git a/proto.h b/proto.h
index d1186ba..202790c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1289,7 +1289,7 @@ PERL_CALLCONV GV* Perl_gv_autoload_sv(pTHX_ HV* stash, SV* namesv, U32 flags)
 #define PERL_ARGS_ASSERT_GV_AUTOLOAD_SV        \
        assert(namesv)
 
-PERL_CALLCONV void     Perl_gv_check(pTHX_ const HV* stash)
+PERL_CALLCONV void     Perl_gv_check(pTHX_ HV* stash)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_CHECK      \
        assert(stash)

diff --git a/t/lib/warnings/perl b/t/lib/warnings/perl
index ad44bbe..e5acc6c 100644 (file)
--- a/t/lib/warnings/perl
+++ b/t/lib/warnings/perl
@@ -246,3 +246,10 @@ BEGIN { ${"_<".__FILE__} = \1 } # should not affect file name in warning
 $foo++;
 EXPECT
 Name "main::foo" used only once: possible typo at - line 4.
+########
+
+use warnings 'once'; # necessary to trigger the crash
+BEGIN{*MUSHROOMS::mushrooms::MUSHROOMS:: = *MUSHROOMS::} # circularity
+$foo++;
+EXPECT
+Name "main::foo" used only once: possible typo at - line 4.