This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_gv_fetchmethod{,_autoload,_flags} are actually never* called with
authorNicholas Clark <nick@ccl4.org>
Thu, 17 Apr 2008 12:47:39 +0000 (12:47 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 17 Apr 2008 12:47:39 +0000 (12:47 +0000)
a non-NULL stash. So change the parameter to NN.
* Fixed the one really obscure hitherto untested case.

p4raw-id: //depot/perl@33706

embed.fnc
gv.c
pp_sys.c
proto.h

index 49eb9c2..48bddee 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -297,9 +297,10 @@ Ap |GV*    |gv_fetchfile_flags|NN const char *const name|const STRLEN len\
                                |const U32 flags
 Apd    |GV*    |gv_fetchmeth   |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
 Apd    |GV*    |gv_fetchmeth_autoload  |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
-Apdmb  |GV*    |gv_fetchmethod |NULLOK HV* stash|NN const char* name
-Apd    |GV*    |gv_fetchmethod_autoload|NULLOK HV* stash|NN const char* name|I32 autoload
-ApdM   |GV*    |gv_fetchmethod_flags|NULLOK HV* stash|NN const char* name \
+Apdmb  |GV*    |gv_fetchmethod |NN HV* stash|NN const char* name
+Apd    |GV*    |gv_fetchmethod_autoload|NN HV* stash|NN const char* name \
+                               |I32 autoload
+ApdM   |GV*    |gv_fetchmethod_flags|NN HV* stash|NN const char* name \
                                |U32 flags
 Ap     |GV*    |gv_fetchpv     |NN const char *nambeg|I32 add|const svtype sv_type
 Ap     |void   |gv_fullname    |NN SV* sv|NN const GV* gv
diff --git a/gv.c b/gv.c
index 5eb09c2..0b17aec 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -622,7 +622,7 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
 
     PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
 
-    if (stash && SvTYPE(stash) < SVt_PVHV)
+    if (SvTYPE(stash) < SVt_PVHV)
        stash = NULL;
 
     for (nend = name; *nend; nend++) {
index 98a958d..59439e9 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -942,7 +942,7 @@ PP(pp_dbmopen)
        PUTBACK;
        require_pv("AnyDBM_File.pm");
        SPAGAIN;
-       if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+       if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
            DIE(aTHX_ "No dbm on this machine");
     }
 
diff --git a/proto.h b/proto.h
index 8d0ae93..cba5fa1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -894,19 +894,22 @@ PERL_CALLCONV GV* Perl_gv_fetchmeth_autoload(pTHX_ HV* stash, const char* name,
        assert(name)
 
 /* PERL_CALLCONV GV*   Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name)
+                       __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2); */
 #define PERL_ARGS_ASSERT_GV_FETCHMETHOD        \
-       assert(name)
+       assert(stash); assert(name)
 
 PERL_CALLCONV GV*      Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload)
+                       __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD       \
-       assert(name)
+       assert(stash); assert(name)
 
 PERL_CALLCONV GV*      Perl_gv_fetchmethod_flags(pTHX_ HV* stash, const char* name, U32 flags)
+                       __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_GV_FETCHMETHOD_FLAGS  \
-       assert(name)
+       assert(stash); assert(name)
 
 PERL_CALLCONV GV*      Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, const svtype sv_type)
                        __attribute__nonnull__(pTHX_1);