universal.c: Ignore SvIsCOW in XS_Internals_SvREADONLY

SvIsCOW used to check SVf_READONLY|SVf_FAKE.  e3918bb703ca changed
that, but did not change the assumptions that code already made (that
there could be not truly read-only COWs.

Now SvREADONLY actually means read-only, so Internals::SvREADONLY
should not be saying that read-ony COWs are not, nor does it need to
flatten COWs when making them read-only.  Hence, locking hash values
no longer has a speed and memory hit if that hash contains COWs.

Part of the code is left in place for PERL_OLD_COPY_ON_WRITE, to avoid
making read-only COWs under that configuration.  See the previous com-
mit for why.

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 32e6f1e..c28c363 100644 (file)
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -962,10 +962,12 @@ unless ($Config{useithreads}) {
     do_test('regular string constant', perl,
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 5
-  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)                # $] < 5.019003
+  FLAGS = \\(PADMY,POK,READONLY,IsCOW,pPOK\\)  # $] >=5.019003
   PV = $ADDR "rules"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
 ');
 
     eval 'index "", perl';
@@ -977,10 +979,12 @@ unless ($Config{useithreads}) {
     do_test('string constant now an FBM', perl,
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 5
-  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)  # $] < 5.019003
+  FLAGS = \\(PADMY,SMG,POK,READONLY,IsCOW,pPOK,VALID,EVALED\\) # $] >=5.019003
   PV = $ADDR "rules"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_regexp
     MG_TYPE = PERL_MAGIC_bm\\(B\\)
@@ -996,10 +1000,12 @@ unless ($Config{useithreads}) {
     do_test('string constant still an FBM', perl,
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 5
-  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)  # $] < 5.019003
+  FLAGS = \\(PADMY,SMG,POK,READONLY,IsCOW,pPOK,VALID,EVALED\\) # $] >=5.019003
   PV = $ADDR "rules"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_regexp
     MG_TYPE = PERL_MAGIC_bm\\(B\\)
@@ -1013,28 +1019,34 @@ unless ($Config{useithreads}) {
     do_test('regular string constant', beer,
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 6
-  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)                # $] < 5.019003
+  FLAGS = \\(PADMY,POK,READONLY,IsCOW,pPOK\\)  # $] >=5.019003
   PV = $ADDR "foamy"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
 ');
 
     is(study beer, 1, "Our studies were successful");
 
     do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 6
-  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)                # $] < 5.019003
+  FLAGS = \\(PADMY,POK,READONLY,IsCOW,pPOK\\)  # $] >=5.019003
   PV = $ADDR "foamy"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
 ');
 
     my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 6
-  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)  # $] < 5.019003
+  FLAGS = \\(PADMY,SMG,POK,READONLY,IsCOW,pPOK,VALID,EVALED\\) # $] >=5.019003
   PV = $ADDR "foamy"\\\0
   CUR = 5
   LEN = \d+
+  COW_REFCNT = 0                               # $] >=5.019003
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_regexp
     MG_TYPE = PERL_MAGIC_bm\\(B\\)

diff --git a/universal.c b/universal.c
index 46511d3..10fefe1 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -912,14 +912,16 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
     sv = SvRV(svz);
 
     if (items == 1) {
-        if (SvREADONLY(sv) && !SvIsCOW(sv))
+        if (SvREADONLY(sv))
             XSRETURN_YES;
         else
             XSRETURN_NO;
     }
     else if (items == 2) {
        if (SvTRUE(ST(1))) {
+#ifdef PERL_OLD_COPY_ON_WRITE
            if (SvIsCOW(sv)) sv_force_normal(sv);
+#endif
            SvREADONLY_on(sv);
            if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
                /* for constant.pm; nobody else should be calling this
@@ -934,7 +936,7 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
        }
        else {
            /* I hope you really know what you are doing. */
-           if (!SvIsCOW(sv)) SvREADONLY_off(sv);
+           SvREADONLY_off(sv);
            XSRETURN_NO;
        }
     }