#!./perl
-print "1..14\n";
+print "1..15\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
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";
+}
require "test.pl";
}
-plan( tests => 62 );
+plan( tests => 64 );
{
my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
"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;
}
require "test.pl";
-plan( tests => 64 );
+plan( tests => 65 );
@foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
("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]);
}
require './test.pl';
-plan(tests => 42);
+plan(tests => 43);
# compile time
# [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);
require 'test.pl';
}
use warnings;
-plan( tests => 180 );
+plan( tests => 181 );
# these shouldn't hang
{
$#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
+} "${\''}", "${\''}";
require './test.pl';
}
-plan( tests => 17 );
+plan( tests => 18 );
sub empty_sub {}
$::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"' }
+ ->("${\''}");
@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} }
}
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 /,
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
require './test.pl';
}
-plan tests => 39;
+plan tests => 40;
$^R = undef;
like( 'a', qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
$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"' })/;