Fix for [perl #40267] PerlIO::scalar doesn't respect readonly-ness

p4raw-id: //depot/perl@28798

diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 160deb2..50a718f 100644 (file)
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -24,6 +24,12 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
      */
     if (arg) {
        if (SvROK(arg)) {
+           if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
+               if (ckWARN(WARN_LAYER))
+                   Perl_warner(aTHX_ packWARN(WARN_LAYER), PL_no_modify);
+               errno = EINVAL;
+               return -1;
+           }
            s->var = SvREFCNT_inc(SvRV(arg));
            if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
                (void)SvPV_nolen(s->var);

diff --git a/ext/PerlIO/t/scalar.t b/ext/PerlIO/t/scalar.t
index 8b43acb..626fe4c 100644 (file)
--- a/ext/PerlIO/t/scalar.t
+++ b/ext/PerlIO/t/scalar.t
@@ -15,7 +15,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..27\n";
+print "1..30\n";
 
 my $fh;
 my $var = "ok 2\n";
@@ -163,3 +163,30 @@ EOF
     close F;
     print $ln eq $s ? "ok 27\n" : "not ok 27\n";
 }
+
+# [perl #40267] PerlIO::scalar doesn't respect readonly-ness
+{
+    if (open(F, '>', \undef)) {
+       print "not ok 28\n";
+    }
+    else {
+       print "ok 28 - \$! is $!\n";
+    }
+    close F;
+    my $ro = \43;
+    if (open(F, '>', $ro)) {
+       print "not ok 29\n";
+    }
+    else {
+       print "ok 29 - \$! is $!\n";
+    }
+    close F;
+    # but we can read from it
+    if (open(F, '<', $ro)) {
+       print "ok 30\n";
+    }
+    else {
+       print "not ok 30 - \$! is $!\n";
+    }
+    close F;
+}