summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-03-30 15:03:50 +0100
committerDavid Mitchell <davem@iabyn.com>2010-03-30 15:03:50 +0100
commit099be4f1d597471eb719c9a344b7c1b55e11ba24 (patch)
tree46ddeb749d35c52c3df9d34f54e7200aef8ddbcf
parent447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab (diff)
downloadperl-099be4f1d597471eb719c9a344b7c1b55e11ba24.tar.gz
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.
-rw-r--r--MANIFEST1
-rw-r--r--gv.c4
-rw-r--r--gv.h1
-rw-r--r--mg.c50
-rw-r--r--pp_hot.c2
-rw-r--r--pp_sys.c6
-rw-r--r--t/io/defout.t47
-rw-r--r--t/op/tie.t12
8 files changed, 98 insertions, 25 deletions
diff --git a/MANIFEST b/MANIFEST
index 07e0e0cd45..e01ecd75aa 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4223,6 +4223,7 @@ t/io/argv.t See if ARGV stuff works
t/io/binmode.t See if binmode() works
t/io/crlf.t See if :crlf works
t/io/crlf_through.t See if pipe passes data intact with :crlf
+t/io/defout.t See if PL_defoutgv works
t/io/dup.t See if >& works right
t/io/errno.t See if $! is correctly set
t/io/fflush.t See if auto-flush on fork/exec/system/qx works
diff --git a/gv.c b/gv.c
index becd1e909a..060d8e605a 100644
--- a/gv.c
+++ b/gv.c
@@ -1468,7 +1468,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
void
Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
- const GV * const egv = GvEGV(gv);
+ const GV * const egv = GvEGVx(gv);
PERL_ARGS_ASSERT_GV_EFULLNAME4;
@@ -2394,7 +2394,7 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
isGV_with_GP(gv) && GvGP(gv) &&
!GvINTRO(gv) && GvREFCNT(gv) == 1 &&
!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) &&
- GvEGV(gv) == gv && (stash = GvSTASH(gv))))
+ GvEGVx(gv) == gv && (stash = GvSTASH(gv))))
return;
cv = GvCV(gv);
if (!cv) {
diff --git a/gv.h b/gv.h
index caef3da82d..be4290dce4 100644
--- a/gv.h
+++ b/gv.h
@@ -114,6 +114,7 @@ Return the SV from the GV.
#define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv)))
#define GvEGV(gv) (GvGP(gv)->gp_egv)
+#define GvEGVx(gv) (isGV_with_GP(gv) ? GvEGV(gv) : NULL)
#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv)
diff --git a/mg.c b/mg.c
index bf8bd53a74..39d608bb5c 100644
--- a/mg.c
+++ b/mg.c
@@ -991,8 +991,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
}
break;
case '^':
- if (GvIOp(PL_defoutgv))
- s = IoTOP_NAME(GvIOp(PL_defoutgv));
+ if (!isGV_with_GP(PL_defoutgv))
+ s = "";
+ else if (GvIOp(PL_defoutgv))
+ s = IoTOP_NAME(GvIOp(PL_defoutgv));
if (s)
sv_setpv(sv,s);
else {
@@ -1001,22 +1003,24 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
}
break;
case '~':
- if (GvIOp(PL_defoutgv))
+ if (!isGV_with_GP(PL_defoutgv))
+ s = "";
+ else if (GvIOp(PL_defoutgv))
s = IoFMT_NAME(GvIOp(PL_defoutgv));
if (!s)
s = GvENAME(PL_defoutgv);
sv_setpv(sv,s);
break;
case '=':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
break;
case '-':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv)));
break;
case '%':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
case ':':
@@ -1027,7 +1031,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop));
break;
case '|':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
break;
case '\\':
@@ -2523,29 +2527,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv);
break;
case '^':
- Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
- IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ if (isGV_with_GP(PL_defoutgv)) {
+ Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
+ s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ }
break;
case '~':
- Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
- IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ if (isGV_with_GP(PL_defoutgv)) {
+ Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
+ s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ }
break;
case '=':
- IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (isGV_with_GP(PL_defoutgv))
+ IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '-':
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
- if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
+ if (isGV_with_GP(PL_defoutgv)) {
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
+ }
break;
case '%':
- IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (isGV_with_GP(PL_defoutgv))
+ IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '|':
{
- IO * const io = GvIOp(PL_defoutgv);
+ IO * const io = GvIO(PL_defoutgv);
if(!io)
break;
if ((SvIV(sv)) == 0)
diff --git a/pp_hot.c b/pp_hot.c
index 8f8af53230..70d35568fd 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -734,7 +734,7 @@ PP(pp_print)
RETURN;
}
if (!(io = GvIO(gv))) {
- if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
+ if ((GvEGVx(gv)) && (io = GvIO(GvEGV(gv)))
&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
diff --git a/pp_sys.c b/pp_sys.c
index e7cdb594b8..8dd8bc0635 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1170,11 +1170,11 @@ PP(pp_select)
dVAR; dSP; dTARGET;
HV *hv;
GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
- GV * egv = GvEGV(PL_defoutgv);
+ GV * egv = GvEGVx(PL_defoutgv);
if (!egv)
egv = PL_defoutgv;
- hv = GvSTASH(egv);
+ hv = isGV_with_GP(egv) ? GvSTASH(egv) : NULL;
if (! hv)
XPUSHs(&PL_sv_undef);
else {
@@ -2017,7 +2017,7 @@ PP(pp_eof)
if (MAXARG)
gv = PL_last_in_gv = MUTABLE_GV(POPs); /* eof(FH) */
else if (PL_op->op_flags & OPf_SPECIAL)
- gv = PL_last_in_gv = GvEGV(PL_argvgv); /* eof() - ARGV magic */
+ gv = PL_last_in_gv = GvEGVx(PL_argvgv); /* eof() - ARGV magic */
else
gv = PL_last_in_gv; /* eof */
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