This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Rename a variable
[perl5.git] / t / op / gv.t
index d71fd0a..8dc7f13 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan(tests => 276 );
+plan(tests => 284);
 
 # type coercion on assignment
 $foo = 'foo';
@@ -240,7 +240,7 @@ is *x{PACKAGE}, 'main', 'and *foo{PACKAGE} the original package';
     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{};
 
@@ -497,7 +497,7 @@ $::{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;
@@ -1153,6 +1153,77 @@ pass "No crash due to CvGV pointing to glob copy in the stash";
     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