This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make SvIsCOW honest about globs
authorFather Chrysostomos <sprout@cpan.org>
Tue, 12 Jul 2011 19:24:29 +0000 (12:24 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 12 Jul 2011 20:00:02 +0000 (13:00 -0700)
SvIsCOW was ignoring the fact that it might be passed a
typeglob, which made its behaviour contradict its docs.

This fixes that and, in doing so, simplifies the
upcoming Internals::SvREADONLY fix.

MANIFEST
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/sviscow.t [new file with mode: 0644]
sv.h

index d19dc37..558bb22 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3715,6 +3715,7 @@ ext/XS-APItest/t/stmtasexpr.t     test recursive descent statement parsing
 ext/XS-APItest/t/stmtsasexpr.t test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string
 ext/XS-APItest/t/stuff_svcur_bug.t     test for a bug in lex_stuff_pvn
 ext/XS-APItest/t/stmtsasexpr.t test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string
 ext/XS-APItest/t/stuff_svcur_bug.t     test for a bug in lex_stuff_pvn
+ext/XS-APItest/t/sviscow.t     Test SvIsCOW
 ext/XS-APItest/t/svpeek.t      XS::APItest extension
 ext/XS-APItest/t/svpv_magic.t  Test behaviour of SvPVbyte and get magic
 ext/XS-APItest/t/svsetsv.t     Test behaviour of sv_setsv with/without PERL_CORE
 ext/XS-APItest/t/svpeek.t      XS::APItest extension
 ext/XS-APItest/t/svpv_magic.t  Test behaviour of SvPVbyte and get magic
 ext/XS-APItest/t/svsetsv.t     Test behaviour of sv_setsv with/without PERL_CORE
index acd1b5e..68533da 100644 (file)
@@ -2858,6 +2858,13 @@ CODE:
        HeVAL(entry) = NULL;
     }
 
        HeVAL(entry) = NULL;
     }
 
+bool
+SvIsCOW(SV *sv)
+CODE:
+    RETVAL = SvIsCOW(sv);
+OUTPUT:
+    RETVAL
+
 MODULE = XS::APItest           PACKAGE = XS::APItest::Magic
 
 PROTOTYPES: DISABLE
 MODULE = XS::APItest           PACKAGE = XS::APItest::Magic
 
 PROTOTYPES: DISABLE
diff --git a/ext/XS-APItest/t/sviscow.t b/ext/XS-APItest/t/sviscow.t
new file mode 100644 (file)
index 0000000..bcc9da8
--- /dev/null
@@ -0,0 +1,13 @@
+use strict;
+use warnings; no warnings 'once';
+
+use Test::More tests => 1;
+
+use XS::APItest;
+use Hash::Util 'lock_value';
+
+my %h;
+$h{g} = *foo;
+lock_value %h, 'g';
+
+ok(!SvIsCOW($h{g}), 'SvIsCOW is honest when it comes to globs');
diff --git a/sv.h b/sv.h
index 5f58935..7686d4e 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1738,8 +1738,8 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>
 #  define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
 #endif /* __GNU__ */
 
 #  define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
 #endif /* __GNU__ */
 
-#define SvIsCOW(sv)            ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
-                                   (SVf_FAKE | SVf_READONLY))
+#define SvIsCOW(sv)    ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
+                          (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv))
 #define SvIsCOW_shared_hash(sv)        (SvIsCOW(sv) && SvLEN(sv) == 0)
 
 #define SvSHARED_HEK_FROM_PV(pvx) \
 #define SvIsCOW_shared_hash(sv)        (SvIsCOW(sv) && SvLEN(sv) == 0)
 
 #define SvSHARED_HEK_FROM_PV(pvx) \