PL_defoutgv isn't always a GV.

Nasty code like the following results in PL_defoutgv not pointing
to a valid GV:

    my $x = *STDERR; select($x); $x = 1;

This causes all sorts of SEGVs when PL_defoutgv is subsequently accessed,
because most code assumes that it has a valid gv_gp pointer.  It also
turns out that PL_defoutgv is under-tested; for example, temporarily
hacking pp_close to make an arg-less close() croak didn't cause any
minitest failures.

Add a new test file that does some basic testing of a bad PL_defoutgv,
and fix all the obvious badness in accessing it.

This also fixes #20727, which although ostensibly a tie bug, was due to
PL_defoutgv pointing to a tiedelem scalar, and fun like that described
above happening.

2 files changed, 59 insertions, 0 deletions

diff --git a/t/io/defout.t b/t/io/defout.t
new file mode 100644
index 0000000000..d99b39bd6c
--- /dev/null
+++ b/t/io/defout.t
@@ -0,0 +1,47 @@
+#!./perl
+#
+# tests for default output handle
+
+# DAPM 30/4/10 this area seems to have been undertested. For now, the only
+# tests are ensuring things don't crash when PL_defoutgv isn't a GV;
+# it probably needs expanding at some point to cover other stuff.
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 16;
+
+
+my $stderr = *STDERR;
+select($stderr);
+$stderr = 1; # whoops, PL_defoutgv no longer a GV!
+
+# note that in the tests below, the return values aren't as important
+# as the fact that they don't crash
+
+ok !print(""), 'print';
+ok !select(), 'select';
+$a = 'fooo';
+format STDERR =
+#@<<
+$a;
+.
+ok ! write(), 'write';
+
+is($^, "",     '$^');
+is($~, "",     '$~');
+is($=, undef,  '$=');
+is($-, undef,  '$-');
+is($%, undef,  '$%');
+is($|, 0,      '$|');
+$^ = 1; pass '$^ = 1';
+$~ = 1; pass '$~ = 1';
+$= = 1; pass '$= = 1';
+$- = 1; pass '$- = 1';
+$% = 1; pass '$% = 1';
+$| = 1; pass '$| = 1';
+ok !close(), 'close';
+
diff --git a/t/op/tie.t b/t/op/tie.t
index 8daa8b06f1..a2e1d4a27b 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -646,3 +646,15 @@ sub TIEHASH { bless [], 'main' }
 }
 print "tied\n" if tied %h;
 EXPECT
+########
+# RT 20727: PL_defoutgv is left as a tied element
+sub TIESCALAR { return bless {}, 'main' }
+
+sub STORE {
+    select($_[1]);
+    $_[1] = 1;
+    select(); # this used to coredump or assert fail
+}
+tie $SELECT, 'main';
+$SELECT = *STDERR;
+EXPECT