From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 10 Jun 2005 15:44:47 +0000 (+0000)
Subject: Passing read only values (such as string constants) to select should
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=729c079f503f2192381f3dac342bae6ced6ca379;p=p5sagit%2Fp5-mst-13.2.git

Passing read only values (such as string constants) to select should
croak.

p4raw-id: //depot/perl@24795
---

diff --git a/MANIFEST b/MANIFEST
index fd78a2a..953bfaf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2895,6 +2895,7 @@ t/op/split.t			See if split works
 t/op/sprintf2.t			See if sprintf works
 t/op/sprintf.t			See if sprintf works
 t/op/srand.t			See if srand works
+t/op/sselect.t			See if 4 argument select works
 t/op/stash.t			See if %:: stashes work
 t/op/stat.t			See if stat works
 t/op/study.t			See if study works
diff --git a/pp_sys.c b/pp_sys.c
index ff80272..1444a0f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1024,9 +1024,16 @@ PP(pp_sselect)
 
     SP -= 4;
     for (i = 1; i <= 3; i++) {
-	if (!SvPOK(SP[i]))
+	SV *sv = SP[i];
+	if (SvOK(sv) && SvREADONLY(sv)) {
+	    if (SvIsCOW(sv))
+		sv_force_normal_flags(sv, 0);
+	    if (SvREADONLY(sv))
+		DIE(aTHX_ PL_no_modify);
+	}
+	if (!SvPOK(sv))
 	    continue;
-	j = SvCUR(SP[i]);
+	j = SvCUR(sv);
 	if (maxlen < j)
 	    maxlen = j;
     }
diff --git a/t/op/sselect.t b/t/op/sselect.t
new file mode 100644
index 0000000..4e50b29
--- /dev/null
+++ b/t/op/sselect.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('.', '../lib');
+}
+
+require 'test.pl';
+
+plan (6);
+
+my $blank = "";
+eval {select undef, $blank, $blank, 0};
+is ($@, "");
+eval {select $blank, undef, $blank, 0};
+is ($@, "");
+eval {select $blank, $blank, undef, 0};
+is ($@, "");
+
+eval {select "", $blank, $blank, 0};
+like ($@, qr/^Modification of a read-only value attempted/);
+eval {select $blank, "", $blank, 0};
+like ($@, qr/^Modification of a read-only value attempted/);
+eval {select $blank, $blank, "", 0};
+like ($@, qr/^Modification of a read-only value attempted/);