Change 34266 by [EMAIL PROTECTED] on 2008/09/04 15:33:04
Integrate:
[ 34092]
Subject: Some more missing isGV_with_GP()s
From: Ben Morrow <[EMAIL PROTECTED]>
Date: Sat, 28 Jun 2008 17:00:17 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 34100]
Fix test count that was missed in #34092
[ 34101]
Skip chown() tests added by #34092 on Win32
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#43 integrate
... //depot/maint-5.10/perl/doio.c#3 integrate
... //depot/maint-5.10/perl/ext/IO/t/io_taint.t#2 integrate
... //depot/maint-5.10/perl/mg.c#14 integrate
... //depot/maint-5.10/perl/pp.c#9 integrate
... //depot/maint-5.10/perl/pp_ctl.c#18 integrate
... //depot/maint-5.10/perl/pp_hot.c#14 integrate
... //depot/maint-5.10/perl/pp_sys.c#7 integrate
... //depot/maint-5.10/perl/sv.c#22 integrate
... //depot/maint-5.10/perl/t/io/pvbm.t#1 branch
... //depot/maint-5.10/perl/t/op/attrs.t#2 integrate
... //depot/maint-5.10/perl/t/op/inc.t#2 integrate
... //depot/maint-5.10/perl/t/op/inccode.t#2 integrate
... //depot/maint-5.10/perl/t/op/magic.t#2 integrate
... //depot/maint-5.10/perl/t/op/ref.t#2 integrate
... //depot/maint-5.10/perl/t/op/undef.t#2 integrate
... //depot/maint-5.10/perl/xsutils.c#3 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#43 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#42~34249~ 2008-09-03 11:00:54.000000000 -0700
+++ perl/MANIFEST 2008-09-04 08:33:04.000000000 -0700
@@ -3555,6 +3555,7 @@
t/io/open.t See if open works
t/io/pipe.t See if secure pipes work
t/io/print.t See if print commands work
+t/io/pvbm.t See if PVBMs break IO commands
t/io/read.t See if read works
t/io/say.t See if say works
t/io/tell.t See if file seeking works
==== //depot/maint-5.10/perl/doio.c#3 (text) ====
Index: perl/doio.c
--- perl/doio.c#2~33139~ 2008-01-30 15:19:42.000000000 -0800
+++ perl/doio.c 2008-09-04 08:33:04.000000000 -0700
@@ -922,7 +922,7 @@
if (!gv)
gv = PL_argvgv;
- if (!gv || SvTYPE(gv) != SVt_PVGV) {
+ if (!gv || !isGV_with_GP(gv)) {
if (not_implicit)
SETERRNO(EBADF,SS_IVCHAN);
return FALSE;
@@ -1294,11 +1294,11 @@
const char *s;
STRLEN len;
PUTBACK;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
gv = (GV*)sv;
goto do_fstat;
}
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
gv = (GV*)SvRV(sv);
goto do_fstat;
}
@@ -1349,7 +1349,7 @@
PL_statgv = NULL;
sv = POPs;
PUTBACK;
- if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) {
+ if (SvROK(sv) && isGV_with_GP(SvRV(sv)) && ckWARN(WARN_IO)) {
Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
GvENAME((GV*) SvRV(sv)));
return (PL_laststatval = -1);
@@ -1604,7 +1604,7 @@
tot = sp - mark;
while (++mark <= sp) {
GV* gv;
- if (SvTYPE(*mark) == SVt_PVGV) {
+ if (isGV_with_GP(*mark)) {
gv = (GV*)*mark;
do_fchmod:
if (GvIO(gv) && IoIFP(GvIOp(gv))) {
@@ -1620,7 +1620,7 @@
tot--;
}
}
- else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+ else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
gv = (GV*)SvRV(*mark);
goto do_fchmod;
}
@@ -1644,7 +1644,7 @@
tot = sp - mark;
while (++mark <= sp) {
GV* gv;
- if (SvTYPE(*mark) == SVt_PVGV) {
+ if (isGV_with_GP(*mark)) {
gv = (GV*)*mark;
do_fchown:
if (GvIO(gv) && IoIFP(GvIOp(gv))) {
@@ -1660,7 +1660,7 @@
tot--;
}
}
- else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+ else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
gv = (GV*)SvRV(*mark);
goto do_fchown;
}
@@ -1816,7 +1816,7 @@
tot = sp - mark;
while (++mark <= sp) {
GV* gv;
- if (SvTYPE(*mark) == SVt_PVGV) {
+ if (isGV_with_GP(*mark)) {
gv = (GV*)*mark;
do_futimes:
if (GvIO(gv) && IoIFP(GvIOp(gv))) {
@@ -1833,7 +1833,7 @@
tot--;
}
}
- else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+ else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
gv = (GV*)SvRV(*mark);
goto do_futimes;
}
==== //depot/maint-5.10/perl/ext/IO/t/io_taint.t#2 (xtext) ====
Index: perl/ext/IO/t/io_taint.t
--- perl/ext/IO/t/io_taint.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/IO/t/io_taint.t 2008-09-04 08:33:04.000000000 -0700
@@ -18,7 +18,7 @@
END { unlink "./__taint__$$" }
-print "1..3\n";
+print "1..5\n";
use IO::File;
$x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
print $x "$$\n";
@@ -43,4 +43,15 @@
print "ok 3\n"; # No Insecure message from using the data
$x->close;
+# this will segfault if it fails
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+eval { IO::Handle::untaint(PVBM) };
+print "ok 4\n";
+
+eval { IO::Handle::untaint(\PVBM) };
+print "ok 5\n";
+
exit 0;
==== //depot/maint-5.10/perl/mg.c#14 (text) ====
Index: perl/mg.c
--- perl/mg.c#13~33955~ 2008-05-30 18:54:46.000000000 -0700
+++ perl/mg.c 2008-09-04 08:33:04.000000000 -0700
@@ -1448,7 +1448,7 @@
PL_psig_name[i] = newSVpvn(s, len);
SvREADONLY_on(PL_psig_name[i]);
}
- if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
+ if (isGV_with_GP(sv) || SvROK(sv)) {
if (i) {
(void)rsignal(i, PL_csighandlerp);
#ifdef HAS_SIGPROCMASK
==== //depot/maint-5.10/perl/pp.c#9 (text) ====
Index: perl/pp.c
--- perl/pp.c#8~33946~ 2008-05-28 16:09:01.000000000 -0700
+++ perl/pp.c 2008-09-04 08:33:04.000000000 -0700
@@ -143,11 +143,11 @@
SvREFCNT_inc_void_NN(sv);
sv = (SV*) gv;
}
- else if (SvTYPE(sv) != SVt_PVGV)
+ else if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a GLOB reference");
}
else {
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
@@ -289,7 +289,7 @@
else {
gv = (GV*)sv;
- if (SvTYPE(gv) != SVt_PVGV) {
+ if (!isGV_with_GP(gv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
@@ -824,9 +824,11 @@
}
break;
case SVt_PVGV:
- if (SvFAKE(sv))
+ if (SvFAKE(sv)) {
SvSetMagicSV(sv, &PL_sv_undef);
- else {
+ break;
+ }
+ else if (isGV_with_GP(sv)) {
GP *gp;
HV *stash;
@@ -844,8 +846,9 @@
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
+ break;
}
- break;
+ /* FALL THROUGH */
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
SvPV_free(sv);
@@ -862,7 +865,7 @@
PP(pp_predec)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
@@ -879,7 +882,7 @@
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
@@ -901,7 +904,7 @@
PP(pp_postdec)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
==== //depot/maint-5.10/perl/pp_ctl.c#18 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#17~34262~ 2008-09-04 00:37:07.000000000 -0700
+++ perl/pp_ctl.c 2008-09-04 08:33:04.000000000 -0700
@@ -3289,11 +3289,11 @@
}
}
- if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) {
+ if (SvROK(arg) && isGV_with_GP(SvRV(arg))) {
arg = SvRV(arg);
}
- if (SvTYPE(arg) == SVt_PVGV) {
+ if (isGV_with_GP(arg)) {
IO * const io = GvIO((GV *)arg);
++filter_has_file;
==== //depot/maint-5.10/perl/pp_hot.c#14 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#13~33943~ 2008-05-28 08:54:22.000000000 -0700
+++ perl/pp_hot.c 2008-09-04 08:33:04.000000000 -0700
@@ -321,8 +321,8 @@
dVAR;
tryAMAGICunTARGET(iter, 0);
PL_last_in_gv = (GV*)(*PL_stack_sp--);
- if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
- if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV)
+ if (!isGV_with_GP(PL_last_in_gv)) {
+ if (SvROK(PL_last_in_gv) && isGV_with_GP(SvRV(PL_last_in_gv)))
PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
else {
dSP;
@@ -411,7 +411,7 @@
PP(pp_preinc)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
@@ -857,7 +857,7 @@
else {
GV *gv;
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
@@ -2665,6 +2665,8 @@
switch (SvTYPE(sv)) {
/* This is overwhelming the most common case: */
case SVt_PVGV:
+ if (!isGV_with_GP(sv))
+ DIE(aTHX_ "Not a CODE reference");
if (!(cv = GvCVu((GV*)sv))) {
HV *stash;
cv = sv_2cv(sv, &stash, &gv, 0);
@@ -3078,7 +3080,9 @@
/* if we got here, ob should be a reference or a glob */
if (!ob || !(SvOBJECT(ob)
- || (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
+ || (SvTYPE(ob) == SVt_PVGV
+ && isGV_with_GP(ob)
+ && (ob = (SV*)GvIO((GV*)ob))
&& SvOBJECT(ob))))
{
Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
==== //depot/maint-5.10/perl/pp_sys.c#7 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#6~33946~ 2008-05-28 16:09:01.000000000 -0700
+++ perl/pp_sys.c 2008-09-04 08:33:04.000000000 -0700
@@ -607,7 +607,7 @@
if (!rgv || !wgv)
goto badexit;
- if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+ if (!isGV_with_GP(rgv) || !isGV_with_GP(wgv))
DIE(aTHX_ PL_no_usym, "filehandle");
rstio = GvIOn(rgv);
wstio = GvIOn(wgv);
@@ -802,19 +802,22 @@
methname = "TIEARRAY";
break;
case SVt_PVGV:
+ if (isGV_with_GP(varsv)) {
#ifdef GV_UNIQUE_CHECK
- if (GvUNIQUE((GV*)varsv)) {
- Perl_croak(aTHX_ "Attempt to tie unique GV");
- }
+ if (GvUNIQUE((GV*)varsv)) {
+ Perl_croak(aTHX_ "Attempt to tie unique GV");
+ }
#endif
- methname = "TIEHANDLE";
- how = PERL_MAGIC_tiedscalar;
- /* For tied filehandles, we apply tiedscalar magic to the IO
- slot of the GP rather than the GV itself. AMS 20010812 */
- if (!GvIOp(varsv))
- GvIOp(varsv) = newIO();
- varsv = (SV *)GvIOp(varsv);
- break;
+ methname = "TIEHANDLE";
+ how = PERL_MAGIC_tiedscalar;
+ /* For tied filehandles, we apply tiedscalar magic to the IO
+ slot of the GP rather than the GV itself. AMS 20010812 */
+ if (!GvIOp(varsv))
+ GvIOp(varsv) = newIO();
+ varsv = (SV *)GvIOp(varsv);
+ break;
+ }
+ /* FALL THROUGH */
default:
methname = "TIESCALAR";
how = PERL_MAGIC_tiedscalar;
@@ -879,7 +882,7 @@
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ if (isGV_with_GP(sv) && !(sv = (SV *)GvIOp(sv)))
RETPUSHYES;
if ((mg = SvTIED_mg(sv, how))) {
@@ -917,7 +920,7 @@
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ if (isGV_with_GP(sv) && !(sv = (SV *)GvIOp(sv)))
RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
@@ -2190,11 +2193,11 @@
SV * const sv = POPs;
const char *name;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate_gv;
}
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
goto do_ftruncate_gv;
}
@@ -2837,10 +2840,10 @@
}
else {
SV* const sv = POPs;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
gv = (GV*)sv;
goto do_fstat;
- } else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ } else if(SvROK(sv) && isGV_with_GP(SvRV(sv))) {
gv = (GV*)SvRV(sv);
if (PL_op->op_type == OP_LSTAT)
goto do_fstat_warning_check;
@@ -3396,10 +3399,10 @@
if (PL_op->op_flags & OPf_SPECIAL) {
gv = gv_fetchsv(sv, 0, SVt_PVIO);
}
- else if (SvTYPE(sv) == SVt_PVGV) {
+ else if (isGV_with_GP(sv)) {
gv = (GV*)sv;
}
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
gv = (GV*)SvRV(sv);
}
else {
==== //depot/maint-5.10/perl/sv.c#22 (text) ====
Index: perl/sv.c
--- perl/sv.c#21~34260~ 2008-09-03 22:17:21.000000000 -0700
+++ perl/sv.c 2008-09-04 08:33:04.000000000 -0700
@@ -1489,6 +1489,8 @@
break;
case SVt_PVGV:
+ if (!isGV_with_GP(sv))
+ break;
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
@@ -1588,6 +1590,8 @@
break;
case SVt_PVGV:
+ if (!isGV_with_GP(sv))
+ break;
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
@@ -7557,11 +7561,14 @@
io = (IO*)sv;
break;
case SVt_PVGV:
- gv = (GV*)sv;
- io = GvIO(gv);
- if (!io)
- Perl_croak(aTHX_ "Bad filehandle: %s", GvNAME(gv));
- break;
+ if (isGV_with_GP(sv)) {
+ gv = (GV*)sv;
+ io = GvIO(gv);
+ if (!io)
+ Perl_croak(aTHX_ "Bad filehandle: %s", GvNAME(gv));
+ break;
+ }
+ /* FALL THROUGH */
default:
if (!SvOK(sv))
Perl_croak(aTHX_ PL_no_usym, "filehandle");
@@ -7612,10 +7619,13 @@
*gvp = NULL;
return NULL;
case SVt_PVGV:
- gv = (GV*)sv;
- *gvp = gv;
- *st = GvESTASH(gv);
- goto fix_gv;
+ if (isGV_with_GP(sv)) {
+ gv = (GV*)sv;
+ *gvp = gv;
+ *st = GvESTASH(gv);
+ goto fix_gv;
+ }
+ /* FALL THROUGH */
default:
if (SvROK(sv)) {
@@ -7630,12 +7640,12 @@
*st = CvSTASH(cv);
return cv;
}
- else if(isGV(sv))
+ else if(isGV_with_GP(sv))
gv = (GV*)sv;
else
Perl_croak(aTHX_ "Not a subroutine reference");
}
- else if (isGV(sv)) {
+ else if (isGV_with_GP(sv)) {
SvGETMAGIC(sv);
gv = (GV*)sv;
}
@@ -7647,7 +7657,7 @@
return NULL;
}
/* Some flags to gv_fetchsv mean don't really create the GV */
- if (SvTYPE(gv) != SVt_PVGV) {
+ if (!isGV_with_GP(gv)) {
*st = NULL;
return NULL;
}
@@ -7854,7 +7864,8 @@
case SVt_PVAV: return "ARRAY";
case SVt_PVHV: return "HASH";
case SVt_PVCV: return "CODE";
- case SVt_PVGV: return "GLOB";
+ case SVt_PVGV: return (char *) (isGV_with_GP(sv)
+ ? "GLOB" : "SCALAR");
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
case SVt_BIND: return "BIND";
==== //depot/maint-5.10/perl/t/io/pvbm.t#1 (text) ====
Index: perl/t/io/pvbm.t
--- /dev/null 2008-08-26 01:15:08.532840418 -0700
+++ perl/t/io/pvbm.t 2008-09-04 08:33:04.000000000 -0700
@@ -0,0 +1,84 @@
+#!./perl
+
+# Test that various IO functions don't try to treat PVBMs as
+# filehandles. Most of these will segfault perl if they fail.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = qw(. ../lib);
+ require "./test.pl";
+}
+
+BEGIN { $| = 1 }
+
+plan(28);
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+{
+ my $which;
+ {
+ package Tie;
+
+ sub TIEHANDLE { $which = 'TIEHANDLE' }
+ sub TIESCALAR { $which = 'TIESCALAR' }
+ }
+ my $pvbm = PVBM;
+
+ tie $pvbm, 'Tie';
+ is ($which, 'TIESCALAR', 'PVBM gets TIESCALAR');
+}
+
+{
+ my $pvbm = PVBM;
+ ok (scalar eval { untie $pvbm; 1 }, 'untie(PVBM) doesn\'t segfault');
+ ok (scalar eval { tied $pvbm; 1 }, 'tied(PVBM) doesn\'t segfault');
+}
+
+{
+ my $pvbm = PVBM;
+
+ ok (scalar eval { pipe $pvbm, PIPE; }, 'pipe(PVBM, ) succeeds');
+ close foo;
+ close PIPE;
+ ok (scalar eval { pipe PIPE, $pvbm; }, 'pipe(, PVBM) succeeds');
+ close foo;
+ close PIPE;
+ ok (!eval { pipe \$pvbm, PIPE; }, 'pipe(PVBM ref, ) fails');
+ ok (!eval { pipe PIPE, \$pvbm; }, 'pipe(, PVBM ref) fails');
+
+ ok (!eval { truncate $pvbm, 0 }, 'truncate(PVBM) fails');
+ ok (!eval { truncate \$pvbm, 0}, 'truncate(PVBM ref) fails');
+
+ ok (!eval { stat $pvbm }, 'stat(PVBM) fails');
+ ok (!eval { stat \$pvbm }, 'stat(PVBM ref) fails');
+
+ ok (!eval { lstat $pvbm }, 'lstat(PVBM) fails');
+ ok (!eval { lstat \$pvbm }, 'lstat(PVBM ref) fails');
+
+ ok (!eval { chdir $pvbm }, 'chdir(PVBM) fails');
+ ok (!eval { chdir \$pvbm }, 'chdir(pvbm ref) fails');
+
+ ok (!eval { close $pvbm }, 'close(PVBM) fails');
+ ok (!eval { close $pvbm }, 'close(PVBM ref) fails');
+
+ ok (!eval { chmod 0600, $pvbm }, 'chmod(PVBM) fails');
+ ok (!eval { chmod 0600, \$pvbm }, 'chmod(PVBM ref) fails');
+
+ SKIP: {
+ skip('chown() not implemented on Win32', 2) if $^O eq 'MSWin32';
+ ok (!eval { chown 0, 0, $pvbm }, 'chown(PVBM) fails');
+ ok (!eval { chown 0, 0, \$pvbm }, 'chown(PVBM ref) fails');
+ }
+
+ ok (!eval { utime 0, 0, $pvbm }, 'utime(PVBM) fails');
+ ok (!eval { utime 0, 0, \$pvbm }, 'utime(PVBM ref) fails');
+
+ ok (!eval { <$pvbm> }, '<PVBM> fails');
+ ok (!eval { readline $pvbm }, 'readline(PVBM) fails');
+ ok (!eval { readline \$pvbm }, 'readline(PVBM ref) fails');
+
+ ok (!eval { open $pvbm, '<', 'none.such' }, 'open(PVBM) fails');
+ ok (!eval { open \$pvbm, '<', 'none.such', }, 'open(PVBM ref) fails');
+}
==== //depot/maint-5.10/perl/t/op/attrs.t#2 (text) ====
Index: perl/t/op/attrs.t
--- perl/t/op/attrs.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/attrs.t 2008-09-04 08:33:04.000000000 -0700
@@ -10,7 +10,7 @@
require './test.pl';
}
-plan 'no_plan';
+plan 90;
$SIG{__WARN__} = sub { die @_ };
@@ -185,3 +185,10 @@
}
}
}
+
+# this will segfault if it fails
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+ok !defined(attributes::get(\PVBM)),
+ 'PVBMs don\'t segfault attributes::get';
==== //depot/maint-5.10/perl/t/op/inc.t#2 (xtext) ====
Index: perl/t/op/inc.t
--- perl/t/op/inc.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/inc.t 2008-09-04 08:33:04.000000000 -0700
@@ -2,7 +2,7 @@
# use strict;
-print "1..34\n";
+print "1..38\n";
my $test = 1;
@@ -194,3 +194,14 @@
$x--;
ok ($x == 0, "(void) i_postdec");
}
+
+# these will segfault if they fail
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+ok (scalar eval { my $pvbm = PVBM; $pvbm++ });
+ok (scalar eval { my $pvbm = PVBM; $pvbm-- });
+ok (scalar eval { my $pvbm = PVBM; ++$pvbm });
+ok (scalar eval { my $pvbm = PVBM; --$pvbm });
+
==== //depot/maint-5.10/perl/t/op/inccode.t#2 (text) ====
Index: perl/t/op/inccode.t
--- perl/t/op/inccode.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/inccode.t 2008-09-04 08:33:04.000000000 -0700
@@ -23,7 +23,7 @@
use File::Spec;
require "test.pl";
-plan(tests => 45 + !$minitest * (3 + 14 * $can_fork));
+plan(tests => 49 + !$minitest * (3 + 14 * $can_fork));
my @tempfiles = ();
@@ -211,6 +211,29 @@
@INC = @old_INC;
}
+# this will segfault if it fails
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+# I don't know whether these requires should succeed or fail. 5.8 failed
+# all of them; 5.10 with an ordinary constant in place of PVBM lets the
+# latter two succeed. For now I don't care, as long as they don't
+# segfault :).
+
+unshift @INC, sub { PVBM };
+eval 'require foo';
+ok( 1, 'returning PVBM doesn\'t segfault require' );
+eval 'use foo';
+ok( 1, 'returning PVBM doesn\'t segfault use' );
+shift @INC;
+unshift @INC, sub { \PVBM };
+eval 'require foo';
+ok( 1, 'returning PVBM ref doesn\'t segfault require' );
+eval 'use foo';
+ok( 1, 'returning PVBM ref doesn\'t segfault use' );
+shift @INC;
+
exit if $minitest;
SKIP: {
==== //depot/maint-5.10/perl/t/op/magic.t#2 (xtext) ====
Index: perl/t/op/magic.t
--- perl/t/op/magic.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/magic.t 2008-09-04 08:33:04.000000000 -0700
@@ -36,7 +36,7 @@
return 1;
}
-print "1..58\n";
+print "1..59\n";
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
@@ -70,7 +70,7 @@
close FOO; # just mention it, squelch used-only-once
if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
- skip('SIGINT not safe on this platform') for 1..4;
+ skip('SIGINT not safe on this platform') for 1..5;
}
else {
# the next tests are done in a subprocess because sh spits out a
@@ -131,7 +131,23 @@
my $todo = ($^O eq 'os2' ? ' # TODO: EMX v0.9d_fix4 bug: wrong nibble? ' :
'');
print $? & 0xFF ? "ok 6$todo\n" : "not ok 6$todo\n";
- $test += 4;
+ open(CMDPIPE, "| $PERL");
+ print CMDPIPE <<'END';
+
+ sub PVBM () { 'foo' }
+ index 'foo', PVBM;
+ my $pvbm = PVBM;
+
+ sub foo { exit 0 }
+
+ $SIG{"INT"} = $pvbm;
+ kill "INT", $$; sleep 1;
+END
+ close CMDPIPE;
+ $? >>= 8 if $^O eq 'VMS';
+ print $? ? "not ok 7\n" : "ok 7\n";
+
+ $test += 5;
}
# can we slice ENV?
==== //depot/maint-5.10/perl/t/op/ref.t#2 (xtext) ====
Index: perl/t/op/ref.t
--- perl/t/op/ref.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/ref.t 2008-09-04 08:33:04.000000000 -0700
@@ -8,7 +8,7 @@
require 'test.pl';
use strict qw(refs subs);
-plan(138);
+plan(182);
# Test glob operations.
@@ -54,11 +54,6 @@
$BAZ = "hit";
is ($$$FOO, 'hit');
-# test that ref(vstring) makes sense
-my $vstref = \v1;
-is (ref($vstref), "VSTRING", "ref(vstr) eq VSTRING");
-like ( $vstref, qr/VSTRING\(0x[0-9a-f]+\)/, '\vstr is also VSTRING');
-
# Test references to real arrays.
my $test = curr_test();
@@ -131,9 +126,49 @@
# Test the ref operator.
-is (ref $subref, 'CODE');
-is (ref $ref, 'ARRAY');
-is (ref $refref, 'HASH');
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+my $pviv = 1; "$pviv";
+my $pvnv = 1.0; "$pvnv";
+my $x;
+
+# we don't test
+# tied lvalue => SCALAR, as we haven't tested tie yet
+# BIND, 'cos we can't create them yet
+# REGEXP, 'cos that requires overload or Scalar::Util
+# LVALUE ref, 'cos I can't work out how to create one :)
+
+for (
+ [ 'undef', SCALAR => \undef ],
+ [ 'constant IV', SCALAR => \1 ],
+ [ 'constant NV', SCALAR => \1.0 ],
+ [ 'constant PV', SCALAR => \'f' ],
+ [ 'scalar', SCALAR => \$x ],
+ [ 'PVIV', SCALAR => \$pviv ],
+ [ 'PVNV', SCALAR => \$pvnv ],
+ [ 'PVMG', SCALAR => \$0 ],
+ [ 'PVBM', SCALAR => \PVBM ],
+ [ 'vstring', VSTRING => \v1 ],
+ [ 'ref', REF => \\1 ],
+ [ 'lvalue', LVALUE => \substr($x, 0, 0) ],
+ [ 'named array', ARRAY => [EMAIL PROTECTED] ],
+ [ 'anon array', ARRAY => [ 1 ] ],
+ [ 'named hash', HASH => \%whatever ],
+ [ 'anon hash', HASH => { a => 1 } ],
+ [ 'named sub', CODE => \&mysub, ],
+ [ 'anon sub', CODE => sub { 1; } ],
+ [ 'glob', GLOB => \*foo ],
+ [ 'format', FORMAT => *STDERR{FORMAT} ],
+) {
+ my ($desc, $type, $ref) = @$_;
+ is (ref $ref, $type, "ref() for ref to $desc");
+ like ("$ref", qr/^$type\(0x[0-9a-f]+\)$/, "stringify for ref to $desc");
+}
+
+is (ref *STDOUT{IO}, 'IO::Handle', 'IO refs are blessed into IO::Handle');
+like (*STDOUT{IO}, qr/^IO::Handle=IO\(0x[0-9a-f]+\)$/,
+ 'stringify for IO refs');
# Test anonymous hash syntax.
@@ -536,6 +571,19 @@
is($ref, *{$ref}{IO}, "IO slot of the temporary glob is set correctly");
}
+# these will segfault if they fail
+
+my $pvbm = PVBM;
+my $rpvbm = \$pvbm;
+
+ok (!eval { *$rpvbm }, 'PVBM ref is not a GLOB ref');
+ok (!eval { *$pvbm }, 'PVBM is not a GLOB ref');
+ok (!eval { $$pvbm }, 'PVBM is not a SCALAR ref');
+ok (!eval { @$pvbm }, 'PVBM is not an ARRAY ref');
+ok (!eval { %$pvbm }, 'PVBM is not a HASH ref');
+ok (!eval { $pvbm->() }, 'PVBM is not a CODE ref');
+ok (!eval { $rpvbm->foo }, 'PVBM is not an object');
+
# Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
$test = curr_test();
curr_test($test + 3);
==== //depot/maint-5.10/perl/t/op/undef.t#2 (xtext) ====
Index: perl/t/op/undef.t
--- perl/t/op/undef.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/undef.t 2008-09-04 08:33:04.000000000 -0700
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..36\n";
+print "1..37\n";
print defined($a) ? "not ok 1\n" : "ok 1\n";
@@ -102,3 +102,13 @@
print "not " if each %hash; print "ok $test\n"; $test++;
print "not " if defined delete $hash{'key2'}; print "ok $test\n"; $test++;
}
+
+# this will segfault if it fails
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+my $pvbm = PVBM;
+undef $pvbm;
+print 'not ' if defined $pvbm;
+print "ok $test\n"; $test++;
==== //depot/maint-5.10/perl/xsutils.c#3 (text) ====
Index: perl/xsutils.c
--- perl/xsutils.c#2~33139~ 2008-01-30 15:19:42.000000000 -0800
+++ perl/xsutils.c 2008-09-04 08:33:04.000000000 -0700
@@ -120,7 +120,7 @@
break;
case 'e':
if (memEQ(name, "uniqu", 5)) {
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
if (negated) {
GvUNIQUE_off(sv);
} else {
@@ -221,7 +221,7 @@
XPUSHs(newSVpvs_flags("unique", SVs_TEMP));
break;
case SVt_PVGV:
- if (GvUNIQUE(sv))
+ if (isGV_with_GP(sv) && GvUNIQUE(sv))
XPUSHs(newSVpvs_flags("unique", SVs_TEMP));
break;
default:
@@ -267,7 +267,7 @@
stash = CvSTASH(sv);
break;
case SVt_PVGV:
- if (GvGP(sv) && GvESTASH((GV*)sv))
+ if (isGV_with_GP(sv) && GvGP(sv) && GvESTASH((GV*)sv))
stash = GvESTASH((GV*)sv);
break;
default:
End of Patch.
