BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
require './test.pl';
+ set_up_inc('../lib');
}
use warnings;
-plan( tests => 267 );
+plan(tests => 284);
# type coercion on assignment
$foo = 'foo';
$warn .= $_[0];
};
my $val = *x{FILEHANDLE};
- print {*x{IO}} ($warn =~ /is deprecated/
+
+ # deprecation warning removed in v5.23 -- rjbs, 2015-12-31
+ # https://rt.perl.org/Ticket/Display.html?id=127060
+ print {*x{IO}} (! defined $warn
? "ok $test\n" : "not ok $test\n");
curr_test(++$test);
}
ok(defined *{$a});
}
-# [ID 20010526.001] localized glob loses value when assigned to
+# [ID 20010526.001 (#7038)] localized glob loses value when assigned to
$j=1; %j=(a=>1); @j=(1); local *j=*j; *j = sub{};
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);
+ our ($glook, $smek, $foof);
# Check reference assignment isn't affected by the SV type (bug #38439)
$glook = 3;
$smek = 4;
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;
+ BEGIN { undef *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.
# This violates perl's internal structures by fiddling with stashes in a
# way that should never happen, but perl should not start trying to free
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');
+}
+
+# [perl #128597] Crash when gp_free calls ckWARN_d
+# I am not sure this test even belongs in this file, as the crash was the
+# result of various features interacting. But a call to ckWARN_d from
+# gv.c:gp_free triggered the crash, so this seems as good a place as any.
+# ‘die’ (or any abnormal scope exit) can cause the current cop to be freed,
+# if the subroutine containing the ‘die’ gets freed as a result. That
+# causes PL_curcop to be set to NULL. If a writable handle gets freed
+# while PL_curcop is NULL, then gp_free will call ckWARN_d while that con-
+# dition still holds, so ckWARN_d needs to know about PL_curcop possibly
+# being NULL.
+SKIP: {
+ skip_if_miniperl("No PerlIO::scalar on miniperl", 1);
+ runperl(prog => 'open my $fh, q|>|, \$buf;'
+ .'my $sub = eval q|sub {exit 0}|; $sub->()');
+ is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
+}
+
+{
+ # [perl #131263]
+ *sym = "\N{U+0080}";
+ ok(*sym eq "*main::\N{U+0080}", "utf8 flag properly set");
+ *sym = "\xC3\x80";
+ ok(*sym eq "*main::\xC3\x80", "utf8 flag properly cleared");
+}
+
+# test gv_try_downgrade()
+# If a GV can be stored in a stash in a compact, non-GV form, then
+# whenever ops are freed which reference the GV, an attempt is made to
+# downgrade the GV to something simpler. Made sure this happens.
+
+package GV_DOWNGRADE {
+ use constant FOO => 1;
+
+ ::like "$GV_DOWNGRADE::{FOO}", qr/SCALAR/, "gv_downgrade: pre";
+ eval q{
+ my $x = \&FOO; # upgrades compact to full GV
+ ::like "$GV_DOWNGRADE::{FOO}", qr/^\*/, "gv_downgrade: full";
+ };
+ # after the eval's ops are freed, the GV should get downgraded again
+ ::like "$GV_DOWNGRADE::{FOO}", qr/SCALAR/, "gv_downgrade: post";
+}
+
+# [perl #131085] This used to crash; no ok() necessary.
+{ no warnings;
+$::{"A131085"} = sub {}; \&{"A131085"};
+}
+
+
+#
+# Deprecated before 5.28, fatal since then
+#
+undef $@;
+eval << '--';
+ sub Other::AUTOLOAD {1}
+ sub Other::fred {}
+ @ISA = qw [Other];
+ fred ();
+ my $x = \&barney;
+ (bless []) -> barney;
+--
+like $@, qr /^Use of inherited AUTOLOAD for non-method main::fred\(\) is no longer allowed/, "Cannot inherit AUTOLOAD";
+
+undef $@;
+eval << '--';
+ use utf8;
+ use open qw [:utf8 :std];
+ sub Oᕞʀ::AUTOLOAD { 1 } sub Oᕞʀ::fᕃƌ {}
+ @ISA = qw(Oᕞʀ) ;
+ fᕃƌ() ;
+--
+like $@, qr /^Use of inherited AUTOLOAD for non-method main::f\x{1543}\x{18c}\(\) is no longer allowed/, "Cannot inherit AUTOLOAD";
+
__END__
Perl
Rules
https://perl5.git.perl.org / perl5.git / blobdiff