BEGIN {
chdir 't' if -d 't';
require './test.pl';
- @INC = () unless is_miniperl();
- unshift @INC, '../lib';
+ set_up_inc('../lib');
}
use warnings;
-plan( tests => 269 );
+plan(tests => 276 );
# type coercion on assignment
$foo = 'foo';
is prototype "yarrow", "", 'const list has "" prototype';
is eval "yarrow", 3, 'const list in scalar cx returns length';
+$::{borage} = \&ok;
+eval 'borage("sub ref in stash")' or fail "sub ref in stash";
+
{
use vars qw($glook $smek $foof);
# Check reference assignment isn't affected by the SV type (bug #38439)
format =
.
-foreach my $value ({1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
+foreach my $value ({1=>2}, *STDOUT{IO}, *STDOUT{FORMAT}) {
# *STDOUT{IO} returns a reference to a PVIO. As it's blessed, ref returns
# IO::Handle, which isn't what we want.
my $type = $value;
"Undefined subroutine &main::foo called at -e line 1.\n",
"gv_try_downgrade does not anonymise CVs referenced elsewhere";
+SKIP: {
+ skip_if_miniperl("no dynamic loading on miniperl, so can't load IO::File", 4);
+
package glob_constant_test {
sub foo { 42 }
use constant bar => *foo;
::is eval { bar->() }, eval { &{+bar} },
'glob_constant->() is not mangled at compile time';
::is "$@", "", 'no error from eval { &{+glob_constant} }';
+ use constant quux => do {
+ local *F;
+ my $f = *F;
+ *$f = *STDOUT{IO};
+ };
+ ::is eval { quux->autoflush; 420 }, 420,
+ 'glob_constant->method() works';
+ ::is "$@", "", 'no error from eval { glob_constant->method() }';
+}
+
+}
+
+{
+ my $free2;
+ local $SIG{__WARN__} = sub { ++$free2 if shift =~ /Attempt to free/ };
+ my $handleref;
+ my $proxy = \$handleref;
+ open $$proxy, "TEST";
+ delete $::{*$handleref{NAME}}; # delete *main::_GEN_xxx
+ undef $handleref;
+ is $free2, undef,
+ 'no double free because of bad rv2gv/newGVgen refcounting';
}
# Look away, please.
eval { $y->() };
pass "No crash due to CvGV pointing to glob copy in the stash";
+# Aliasing should disable no-common-vars optimisation.
+{
+ *x = *y;
+ $x = 3;
+ ($x, my $z) = (1, $y);
+ is $z, 3, 'list assignment after aliasing [perl #89646]';
+}
+
+# RT #125840: make sure *x = $x doesn't do bad things by freeing $x before
+# it's assigned.
+
+{
+ $a_125840 = 1;
+ $b_125840 = 2;
+ $a_125840 = *b_125840;
+ *a_125840 = $a_125840;
+ is($a_125840, 2, 'RT #125840: *a = $a');
+
+ $c_125840 = 1;
+ $d_125840 = 2;
+ *d_125840 = $d_125840 = *c_125840;
+ is($d_125840, 1, 'RT #125840: *d=$d=*c');
+ $c_125840 = $d_125840;
+ is($c_125840, 1, 'RT #125840: $c=$d');
+}
+
+
__END__
Perl
Rules