From 2d885586322c253eddc480955aad8cbaef88e2ca Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 15 Jun 2013 19:14:14 -0700
Subject: [PATCH] To-do tests for perl #78194

plus a regular (not to-do) test for an lvalue sub case that already
works properly.
---
 t/cmd/for.t     |  8 +++++++-
 t/op/grep.t     | 10 +++++++++-
 t/op/list.t     | 11 ++++++++++-
 t/op/repeat.t   | 10 +++++++++-
 t/op/sort.t     |  7 ++++++-
 t/op/sub.t      |  8 +++++++-
 t/op/sub_lval.t |  7 ++++++-
 t/op/tie.t      |  9 +++++++++
 t/re/rxcode.t   |  7 ++++++-
 9 files changed, 69 insertions(+), 8 deletions(-)

diff --git a/t/cmd/for.t b/t/cmd/for.t
index 27fb5a2..e187f7f 100644
--- a/t/cmd/for.t
+++ b/t/cmd/for.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..14\n";
+print "1..15\n";
 
 for ($i = 0; $i <= 10; $i++) {
     $x[$i] = $i;
@@ -95,3 +95,9 @@ print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n";
     print $x == 1 ? "ok" : "not ok", " 14 - double destroy, x=$x\n";
 }
 
+# [perl #78194] foreach() aliasing op return values
+for ("${\''}") {
+    print "not " unless \$_ == \$_;
+    print 'ok 15 - [perl \#78194] \$_ == \$_ inside for("$x"){...}',
+          " # TODO \n";
+}
diff --git a/t/op/grep.t b/t/op/grep.t
index 94fa43c..d533aa8 100644
--- a/t/op/grep.t
+++ b/t/op/grep.t
@@ -10,7 +10,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan( tests => 62 );
+plan( tests => 64 );
 
 {
     my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
@@ -215,6 +215,14 @@ plan( tests => 62 );
          "proper error on variable as block. [perl #37314]");
 }
 
+# [perl #78194] grep/map aliasing op return values
+{ local $::TODO = ' ';
+grep is(\$_, \$_, '[perl #78194] \$_ == \$_ inside grep ..., "$x"'),
+     "${\''}";
+map is(\$_, \$_, '[perl #78194] \$_ == \$_ inside map ..., "$x"'),
+     "${\''}";
+}
+
 # [perl #92254] freeing $_ in gremap block
 {
     my $y;
diff --git a/t/op/list.t b/t/op/list.t
index 87045fc..91bf321 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 64 );
+plan( tests => 65 );
 
 @foo = (1, 2, 3, 4);
 cmp_ok($foo[0], '==', 1, 'first elem');
@@ -182,3 +182,12 @@ cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list (..).(..)');
     ("const", my $x) ||= 1;
     is( $x, 1 );
 }
+
+# [perl #78194] list slice aliasing op return values
+$::TODO = 'not fixed yet';
+sub {
+ is(\$_[0], \$_[1],
+  '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by lslice'
+ )
+}
+ ->(("${\''}")[0,0]);
diff --git a/t/op/repeat.t b/t/op/repeat.t
index d1083e8..3874b1a 100644
--- a/t/op/repeat.t
+++ b/t/op/repeat.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan(tests => 42);
+plan(tests => 43);
 
 # compile time
 
@@ -154,3 +154,11 @@ is(77, scalar ((1,7)x2),    'stack truncation');
 
 # [perl #35885]
 is( (join ',', (qw(a b c) x 3)), 'a,b,c,a,b,c,a,b,c', 'x on qw produces list' );
+
+# [perl #78194] x aliasing op return values
+$::TODO = 'not fixed yet';
+sub {
+    is(\$_[0], \$_[1],
+      '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by x')
+}
+ ->(("${\''}")x2);
diff --git a/t/op/sort.t b/t/op/sort.t
index ed4048c..1461daf 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 180 );
+plan( tests => 181 );
 
 # these shouldn't hang
 {
@@ -1007,3 +1007,8 @@ is $@, "",
 $#a = -1;
 () = [sort { $a = 10; $b = 10; 0 } $#a, $#a];
 is $#a, 10, 'sort block modifying $a and $b';
+
+$::TODO = ' ';
+() = sort {
+    is \$a, \$a, '[perl #78194] op return values passed to sort'; 0
+} "${\''}", "${\''}";
diff --git a/t/op/sub.t b/t/op/sub.t
index e00f26f..d328ac3 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 17 );
+plan( tests => 18 );
 
 sub empty_sub {}
 
@@ -108,3 +108,9 @@ require Config;
 $::TODO = "not fixed yet" if $Config::Config{useithreads};
 is "@scratch", "main road road main",
    'recursive calls do not share shared-hash-key TARGs';
+
+$::TODO = "not fixed yet";
+# [perl #78194] @_ aliasing op return values
+sub { is \$_[0], \$_[0],
+        '[perl #78194] \$_[0] == \$_[0] when @_ aliases "$x"' }
+ ->("${\''}");
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index 9be3164..489583e 100644
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>192;
+plan tests=>193;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -963,6 +963,11 @@ sub ucfr : lvalue {
 }
 ucfr();
 
+# Test TARG with potential lvalue context, too
+for (sub : lvalue { "$x" }->()) {
+    is \$_, \$_, '\$_ == \$_ in for(sub :lvalue{"$x"}->()){...}'
+}
+
 # [perl #117947] XSUBs should not be treated as lvalues at run time
 eval { &{\&utf8::is_utf8}("") = 3 };
 like $@, qr/^Can't modify non-lvalue subroutine call at /,
diff --git a/t/op/tie.t b/t/op/tie.t
index 668e919..7074c55 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -1368,3 +1368,12 @@ undef
 undef
 no
 no
+########
+
+# TODO [perl #78194] Passing op return values to tie constructors
+sub TIEARRAY{
+    print \$_[1] == \$_[1] ? "ok\n" : "not ok\n";
+};
+tie @a, "", "$a$b";
+EXPECT
+ok
diff --git a/t/re/rxcode.t b/t/re/rxcode.t
index 16bc4b7..2845b7b 100644
--- a/t/re/rxcode.t
+++ b/t/re/rxcode.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 39;
+plan tests => 40;
 
 $^R = undef;
 like( 'a',  qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
@@ -91,3 +91,8 @@ cmp_ok( scalar(@var), '==', 0, '..still nothing pushed (package)' );
     $x = "(?{})";
     is eval { "a" =~ /a++(?{})+$x/x } || $@, '1', '/a++(?{})+$code_block/'
 }
+
+$::TODO = "not fixed yet";
+# [perl #78194] $_ in code block aliasing op return values
+"$_" =~ /(?{ is \$_, \$_,
+               '[perl #78194] \$_ == \$_ when $_ aliases "$x"' })/;
-- 
2.7.4