This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #112316] Make strict vars respect assignment from null pkg
authorFather Chrysostomos <sprout@cpan.org>
Mon, 9 Apr 2012 03:25:52 +0000 (20:25 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 20 Apr 2012 03:09:11 +0000 (20:09 -0700)
Under threads, strict vars was not respecting glob assignment from a
package with a null in its name if the name of the package assigned to
was equal to the prefix of the current package up to the null.

cop.h
embed.fnc
gv.c
op.c
proto.h
scope.h
t/lib/strict/vars
util.c

diff --git a/cop.h b/cop.h
index 8690494..0cfeb44 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -389,7 +389,7 @@ struct cop {
 #ifdef USE_ITHREADS
     char *     cop_stashpv;    /* package line was compiled in */
     char *     cop_file;       /* file name the following line # is from */
-    U32         cop_stashflags; /* currently only SVf_UTF8 */
+    I32         cop_stashlen;  /* negative for UTF8 */
 #else
     HV *       cop_stash;      /* package line was compiled in */
     GV *       cop_filegv;     /* file the following line # is from */
@@ -429,25 +429,32 @@ struct cop {
 #  define CopSTASHPV(c)                ((c)->cop_stashpv)
 
 #  ifdef NETWARE
-#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL))
+#    define CopSTASHPV_set(c,pv,n)     ((c)->cop_stashpv = \
+                                          ((pv) ? savepvn(pv,n) : NULL))
 #  else
-#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = savesharedpv(pv))
+#    define CopSTASHPV_set(c,pv,n)     ((c)->cop_stashpv = (pv) \
+                                           ? savesharedpvn(pv,n) : NULL)
 #  endif
 
-#  define CopSTASH_flags(c)            ((c)->cop_stashflags)
-#  define CopSTASH_flags_set(c,flags)  ((c)->cop_stashflags = flags)
+#  define CopSTASH_len_set(c,n)        ((c)->cop_stashlen = (n))
+#  define CopSTASH_len(c)      ((c)->cop_stashlen)
 
 #  define CopSTASH(c)          (CopSTASHPV(c)                                 \
-                                ? gv_stashpv(CopSTASHPV(c),                   \
-                                            GV_ADD|(CopSTASH_flags(c)          \
-                                                    ? CopSTASH_flags(c): 0 )) \
+                                ? gv_stashpvn(CopSTASHPV(c),             \
+                                   CopSTASH_len(c) < 0                   \
+                                       ? -CopSTASH_len(c)                \
+                                       :  CopSTASH_len(c),               \
+                                    GV_ADD|SVf_UTF8*(CopSTASH_len(c) < 0) \
+                                  )                                      \
                                  : NULL)
-#  define CopSTASH_set(c,hv)   (CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL), \
-                                CopSTASH_flags_set(c,                            \
-                                            ((hv) && HvNAME_HEK(hv) &&              \
-                                                     HvNAMEUTF8(hv))                \
-                                                ? SVf_UTF8                          \
-                                                : 0))
+#  define CopSTASH_set(c,hv)   (CopSTASHPV_set(c,                      \
+                                   (hv) ? HvNAME_get(hv) : NULL,       \
+                                   (hv) ? HvNAMELEN(hv)  : 0),         \
+                               CopSTASH_len_set(c,                     \
+                                   (hv) ? HvNAMEUTF8(hv)               \
+                                           ? -HvNAMELEN(hv)            \
+                                           :  HvNAMELEN(hv)            \
+                                        : 0))
 #  define CopSTASH_eq(c,hv)    ((hv) && stashpv_hvname_match(c,hv))
 #  ifdef NETWARE
 #    define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
index 17d5bcf..ab2b2f8 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1111,7 +1111,10 @@ p        |I32    |same_dirent    |NN const char* a|NN const char* b
 Apda   |char*  |savepv         |NULLOK const char* pv
 Apda   |char*  |savepvn        |NULLOK const char* pv|I32 len
 Apda   |char*  |savesharedpv   |NULLOK const char* pv
-Apda   |char*  |savesharedpvn  |NN const char *const pv|const STRLEN len
+
+: NULLOK only to suppress a compiler warning
+Apda   |char*  |savesharedpvn  |NULLOK const char *const pv \
+                               |const STRLEN len
 Apda   |char*  |savesharedsvpv |NN SV *sv
 Apda   |char*  |savesvpv       |NN SV* sv
 Ap     |void   |savestack_grow
diff --git a/gv.c b/gv.c
index a61c34f..f51fe05 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -911,8 +911,10 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
     sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
 #ifdef USE_ITHREADS
     av_push(superisa, newSVpvn_flags(CopSTASHPV(PL_curcop),
-                                     strlen(CopSTASHPV(PL_curcop)),
-                                     CopSTASH_flags(PL_curcop)
+                                     CopSTASH_len(PL_curcop) < 0
+                                       ? -CopSTASH_len(PL_curcop)
+                                       :  CopSTASH_len(PL_curcop),
+                                     SVf_UTF8*(CopSTASH_len(PL_curcop) < 0)
                                     ));
 #else
     av_push(superisa, newSVhek(CopSTASH(PL_curcop)
diff --git a/op.c b/op.c
index 4c3d6d0..3deb025 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10007,6 +10007,7 @@ Perl_rpeep(pTHX_ register OP *o)
                    firstcop->cop_line = secondcop->cop_line;
 #ifdef USE_ITHREADS
                    firstcop->cop_stashpv = secondcop->cop_stashpv;
+                   firstcop->cop_stashlen = secondcop->cop_stashlen;
                    firstcop->cop_file = secondcop->cop_file;
 #else
                    firstcop->cop_stash = secondcop->cop_stash;
diff --git a/proto.h b/proto.h
index a9bd7c5..11a7d1b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3556,10 +3556,7 @@ PERL_CALLCONV char*      Perl_savesharedpv(pTHX_ const char* pv)
 
 PERL_CALLCONV char*    Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
                        __attribute__malloc__
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SAVESHAREDPVN \
-       assert(pv)
+                       __attribute__warn_unused_result__;
 
 PERL_CALLCONV char*    Perl_savesharedsvpv(pTHX_ SV *sv)
                        __attribute__malloc__
diff --git a/scope.h b/scope.h
index 22407e1..aa04a79 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -235,7 +235,8 @@ scope has the given name. Name must be a literal string.
 #define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER)
 
 #ifdef USE_ITHREADS
-#  define SAVECOPSTASH(c)      SAVEPPTR(CopSTASHPV(c))
+#  define SAVECOPSTASH(c)      (SAVEPPTR(CopSTASHPV(c)), \
+                                SAVEI32(CopSTASH_len(c)))
 #  define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c))
 #  define SAVECOPFILE(c)       SAVEPPTR(CopFILE(c))
 #  define SAVECOPFILE_FREE(c)  SAVESHAREDPV(CopFILE(c))
index 28aab48..568d991 100644 (file)
@@ -545,3 +545,12 @@ package foo;
 use strict;
 eval 'package Foo; @bar = 1' or die;
 EXPECT
+########
+# [perl #112316] strict vars getting confused by nulls
+# Assigning from within a package whose name contains a null
+BEGIN { *Foo:: = *{"foo\0bar::"} }
+package Foo;
+*foo::bar = [];
+use strict;
+eval 'package foo; @bar = 1' or die;
+EXPECT
diff --git a/util.c b/util.c
index cba3c7b..500bef5 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1182,7 +1182,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
 {
     char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
 
-    PERL_ARGS_ASSERT_SAVESHAREDPVN;
+    /* PERL_ARGS_ASSERT_SAVESHAREDPVN; */
 
     if (!newaddr) {
        return write_no_mem();
@@ -5854,25 +5854,27 @@ Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
 {
     const char * stashpv = CopSTASHPV(c);
     const char * name    = HvNAME_get(hv);
+    const bool utf8 = CopSTASH_len(c) < 0;
+    const I32  len  = utf8 ? -CopSTASH_len(c) : CopSTASH_len(c);
     PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH;
 
     if (!stashpv || !name)
        return stashpv == name;
-    if ( HvNAMEUTF8(hv) && !(CopSTASH_flags(c) & SVf_UTF8 ? 1 : 0) ) {
-        if (CopSTASH_flags(c) & SVf_UTF8) {
+    if ( HvNAMEUTF8(hv) && !utf8 ) {
+        if (utf8) {
             return (bytes_cmp_utf8(
-                        (const U8*)stashpv, strlen(stashpv),
+                        (const U8*)stashpv, len,
                         (const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0);
         } else {
             return (bytes_cmp_utf8(
                         (const U8*)name, HEK_LEN(HvNAME_HEK(hv)),
-                        (const U8*)stashpv, strlen(stashpv)) == 0);
+                        (const U8*)stashpv, len) == 0);
         }
     }
     else
         return (stashpv == name
-                    || ((STRLEN)HEK_LEN(HvNAME_HEK(hv)) == strlen(stashpv)
+                    || (HEK_LEN(HvNAME_HEK(hv)) == len
                         && strEQ(stashpv, name)));
     /*NOTREACHED*/
     return FALSE;