stop lc() etc accidentally modifying in-place.

As an optimisation, [ul]c() and [ul]cfirst() sometimes modify their
argument in-place rather than returning a modified copy.

This should only be done when there is no possibility that the arg is
going to be reused. However, this fails:

    use List::Util qw{ first };
    my %hash = ( ASD => 1, ZXC => 2, QWE => 3, TYU => 4);
    print first { lc $_ eq 'qwe' } keys %hash;

which prints "qwe" rather than "QWE".

Bascally everything in perl that sets $_ or $a/$b and calls a code block
or function, such as map, grep, for and, sort, either copies any PADTMPs,
turns off SvTEMP, and/or bumps the reference count.

List::Util doesn't do this, and it is likely that other CPAN modules
which do "set $_ and call a block" don't either.

This has been failing since 5.20.0: perl has been in-placing if the arg is
(SvTEMP && RC==1 && !mg) (due to v5.19.7-112-g5cd5e2d).

Make the optimisation critera stricter by always copying SvTEMPs.
It still allows the optimisation if the arg is a PADTMP - I don't know
whether this is unsafe too.

Perhaps we can think of something better after 5.24?

(cherry picked from commit 1921e03146ca6022defa6af5267c4dd20c0ca699)

2 files changed, 28 insertions, 12 deletions

diff --git a/pp.c b/pp.c
index c8d4856f81..3173c5ab25 100644
--- a/pp.c
+++ b/pp.c
@@ -3681,10 +3681,7 @@ PP(pp_ucfirst)
     /* We may be able to get away with changing only the first character, in
      * place, but not if read-only, etc.  Later we may discover more reasons to
      * not convert in-place. */
-    inplace = !SvREADONLY(source)
-	   && (  SvPADTMP(source)
-	      || (  SvTEMP(source) && !SvSMAGICAL(source)
-		 && SvREFCNT(source) == 1));
+    inplace = !SvREADONLY(source) && SvPADTMP(source);
 
     /* First calculate what the changed first character should be.  This affects
      * whether we can just swap it out, leaving the rest of the string unchanged,
@@ -3924,9 +3921,7 @@ PP(pp_uc)
 
     SvGETMAGIC(source);
 
-    if ((SvPADTMP(source)
-	 ||
-	(SvTEMP(source) && !SvSMAGICAL(source) && SvREFCNT(source) == 1))
+    if (   SvPADTMP(source)
 	&& !SvREADONLY(source) && SvPOK(source)
 	&& !DO_UTF8(source)
 	&& (
@@ -4179,10 +4174,7 @@ PP(pp_lc)
 
     SvGETMAGIC(source);
 
-    if (   (  SvPADTMP(source)
-	   || (  SvTEMP(source) && !SvSMAGICAL(source)
-	      && SvREFCNT(source) == 1  )
-	   )
+    if (   SvPADTMP(source)
 	&& !SvREADONLY(source) && SvPOK(source)
 	&& !DO_UTF8(source)) {
 
diff --git a/t/op/lc.t b/t/op/lc.t
index ffea0ae784..9f2bdb0627 100644
--- a/t/op/lc.t
+++ b/t/op/lc.t
@@ -1,6 +1,8 @@
 #!./perl
 
 # This file is intentionally encoded in latin-1.
+#
+# Test uc(), lc(), fc(), ucfirst(), lcfirst(), quotemeta() etc
 
 BEGIN {
     chdir 't' if -d 't';
@@ -14,7 +16,7 @@ BEGIN {
 
 use feature qw( fc );
 
-plan tests => 134 + 4 * 256;
+plan tests => 139 + 4 * 256;
 
 is(lc(undef),	   "", "lc(undef) is ''");
 is(lcfirst(undef), "", "lcfirst(undef) is ''");
@@ -317,6 +319,28 @@ $h{k} = bless[], "\x{130}bcde"; # U+0130 grows with lc()
 like lc delete $h{k}, qr "^i\x{307}bcde=array\(.*\)",
     'lc(TEMP ref) does not produce a corrupt string';
 
+# List::Util::first() etc sets $_ to an SvTEMP without raising its
+# refcount.  This was causing lc() etc to unsafely modify in-place.
+# see http://nntp.perl.org/group/perl.perl5.porters/228213
+
+SKIP: {
+    skip "no List::Util on miniperl", 5, if is_miniperl;
+    require List::Util;
+    my %hl = qw(a 1 b 2 c 3);
+    my %hu = qw(A 1 B 2 C 3);
+    my $x;
+    $x = List::Util::first(sub { uc      $_ eq 'A' }, keys %hl);
+    is($x, "a", "first { uc }");
+    $x = List::Util::first(sub { ucfirst $_ eq 'A' }, keys %hl);
+    is($x, "a", "first { ucfirst }");
+    $x = List::Util::first(sub { lc      $_ eq 'a' }, keys %hu);
+    is($x, "A", "first { lc }");
+    $x = List::Util::first(sub { lcfirst $_ eq 'a' }, keys %hu);
+    is($x, "A", "first { lcfirst }");
+    $x = List::Util::first(sub { fc      $_ eq 'a' }, keys %hu);
+    is($x, "A", "first { fc }");
+}
+
 
 my $utf8_locale = find_utf8_ctype_locale();