Change 33856 by [EMAIL PROTECTED] on 2008/05/18 16:11:18
Integrate:
[ 32937]
Ensure DEBUG_LEAKING_SCALARS_ABORT can't be circumvented by fatal
warnings. Add an abort() if you try to dup a freed scalar.
[ 32979]
Subject: [PATCH-revised] Fix range operator
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Mon, 14 Jan 2008 19:56:48 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 33020]
Encode the G_* to OPf_WANT_* transform, the reverse of OP_GIMME(), in
a macro OP_GIMME_REVERSE() [so that it could be changed].
[ 33021]
Add a flag G_WANT, as a mask for the bits G_SCALAR, G_ARRAY and G_VOID.
Affected files ...
... //depot/maint-5.10/perl/cop.h#5 integrate
... //depot/maint-5.10/perl/op.h#5 integrate
... //depot/maint-5.10/perl/perl.c#11 integrate
... //depot/maint-5.10/perl/pp_ctl.c#12 integrate
... //depot/maint-5.10/perl/pp_hot.c#11 integrate
... //depot/maint-5.10/perl/sv.c#14 integrate
... //depot/maint-5.10/perl/t/op/range.t#2 integrate
Differences ...
==== //depot/maint-5.10/perl/cop.h#5 (text) ====
Index: perl/cop.h
--- perl/cop.h#4~33157~ 2008-01-31 13:43:37.000000000 -0800
+++ perl/cop.h 2008-05-18 09:11:18.000000000 -0700
@@ -722,6 +722,7 @@
#define G_SCALAR 0
#define G_ARRAY 1
#define G_VOID 128 /* skip this bit when adding flags below */
+#define G_WANT (128|1)
/* extra flags for Perl_call_* routines */
#define G_DISCARD 2 /* Call FREETMPS.
==== //depot/maint-5.10/perl/op.h#5 (text) ====
Index: perl/op.h
--- perl/op.h#4~33141~ 2008-01-30 15:50:34.000000000 -0800
+++ perl/op.h 2008-05-18 09:11:18.000000000 -0700
@@ -70,6 +70,11 @@
((op)->op_flags & OPf_WANT) == OPf_WANT_LIST ? G_ARRAY : \
dfl)
+#define OP_GIMME_REVERSE(flags) \
+ ((flags & G_VOID) ? OPf_WANT_VOID : \
+ (flags & G_ARRAY) ? OPf_WANT_LIST : \
+ OPf_WANT_SCALAR)
+
/*
=head1 "Gimme" Values
==== //depot/maint-5.10/perl/perl.c#11 (text) ====
Index: perl/perl.c
--- perl/perl.c#10~33855~ 2008-05-18 07:30:48.000000000 -0700
+++ perl/perl.c 2008-05-18 09:11:18.000000000 -0700
@@ -2602,9 +2602,7 @@
myop.op_next = NULL;
if (!(flags & G_NOARGS))
myop.op_flags |= OPf_STACKED;
- myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
- (flags & G_ARRAY) ? OPf_WANT_LIST :
- OPf_WANT_SCALAR);
+ myop.op_flags |= OP_GIMME_REVERSE(flags);
SAVEOP();
PL_op = (OP*)&myop;
@@ -2673,7 +2671,7 @@
goto redo_body;
}
PL_stack_sp = PL_stack_base + oldmark;
- if (flags & G_ARRAY)
+ if ((flags & G_WANT) == G_ARRAY)
retval = 0;
else {
retval = 1;
@@ -2736,9 +2734,7 @@
myop.op_flags = OPf_STACKED;
myop.op_next = NULL;
myop.op_type = OP_ENTEREVAL;
- myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
- (flags & G_ARRAY) ? OPf_WANT_LIST :
- OPf_WANT_SCALAR);
+ myop.op_flags |= OP_GIMME_REVERSE(flags);
if (flags & G_KEEPERR)
myop.op_flags |= OPf_SPECIAL;
@@ -2774,7 +2770,7 @@
goto redo_body;
}
PL_stack_sp = PL_stack_base + oldmark;
- if (flags & G_ARRAY)
+ if ((flags & G_WANT) == G_ARRAY)
retval = 0;
else {
retval = 1;
==== //depot/maint-5.10/perl/pp_ctl.c#12 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#11~33785~ 2008-05-04 05:46:52.000000000 -0700
+++ perl/pp_ctl.c 2008-05-18 09:11:18.000000000 -0700
@@ -1855,8 +1855,25 @@
SvGETMAGIC(sv);
SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
- if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
- (SvOK(right) && SvNV(right) >= IV_MAX))
+#ifdef NV_PRESERVES_UV
+ if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
+ (SvNV(sv) > (NV)IV_MAX)))
+ ||
+ (SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
+ (SvNV(right) < (NV)IV_MIN))))
+#else
+ if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
+ ||
+ ((SvNV(sv) > 0) &&
+ ((SvUV(sv) > (UV)IV_MAX) ||
+ (SvNV(sv) > (NV)UV_MAX)))))
+ ||
+ (SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
+ ||
+ ((SvNV(right) > 0) &&
+ ((SvUV(right) > (UV)IV_MAX) ||
+ (SvNV(right) > (NV)UV_MAX))))))
+#endif
DIE(aTHX_ "Range iterator outside integer range");
cx->blk_loop.iterix = SvIV(sv);
cx->blk_loop.itermax = SvIV(right);
==== //depot/maint-5.10/perl/pp_hot.c#11 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#10~33157~ 2008-01-31 13:43:37.000000000 -0800
+++ perl/pp_hot.c 2008-05-18 09:11:18.000000000 -0700
@@ -1949,6 +1949,15 @@
*itersvp = newSViv(cx->blk_loop.iterix++);
SvREFCNT_dec(oldsv);
}
+
+ /* Handle end of range at IV_MAX */
+ if ((cx->blk_loop.iterix == IV_MIN) &&
+ (cx->blk_loop.itermax == IV_MAX))
+ {
+ cx->blk_loop.iterix++;
+ cx->blk_loop.itermax++;
+ }
+
RETPUSHYES;
}
==== //depot/maint-5.10/perl/sv.c#14 (text) ====
Index: perl/sv.c
--- perl/sv.c#13~33802~ 2008-05-10 07:15:40.000000000 -0700
+++ perl/sv.c 2008-05-18 09:11:18.000000000 -0700
@@ -5340,15 +5340,23 @@
return;
}
if (ckWARN_d(WARN_INTERNAL)) {
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Attempt to free unreferenced scalar: SV 0x%"UVxf
- pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
Perl_dump_sv_child(aTHX_ sv);
#else
#ifdef DEBUG_LEAKING_SCALARS
- sv_dump(sv);
+ sv_dump(sv);
#endif
+#ifdef DEBUG_LEAKING_SCALARS_ABORT
+ if (PL_warnhook == PERL_WARNHOOK_FATAL
+ || ckDEAD(packWARN(WARN_INTERNAL))) {
+ /* Don't let Perl_warner cause us to escape our fate: */
+ abort();
+ }
+#endif
+ /* This may not return: */
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+ "Attempt to free unreferenced scalar: SV 0x%"UVxf
+ pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
#endif
}
#ifdef DEBUG_LEAKING_SCALARS_ABORT
@@ -10066,8 +10074,14 @@
dVAR;
SV *dstr;
- if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
+ if (!sstr)
return NULL;
+ if (SvTYPE(sstr) == SVTYPEMASK) {
+#ifdef DEBUG_LEAKING_SCALARS_ABORT
+ abort();
+#endif
+ return NULL;
+ }
/* look for it in the table first */
dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
if (dstr)
==== //depot/maint-5.10/perl/t/op/range.t#2 (xtext) ====
Index: perl/t/op/range.t
--- perl/t/op/range.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/range.t 2008-05-18 09:11:18.000000000 -0700
@@ -9,7 +9,7 @@
use Config;
-plan (45);
+plan (115);
is(join(':',1..5), '1:2:3:4:5');
@@ -188,3 +188,157 @@
@foo=(); push @foo, $_ for $1.."";
is(join(":", map "[$_]", @foo), '');
}
+
+# Test upper range limit
+my $MAX_INT = ~0>>1;
+
+foreach my $ii (-3 .. 3) {
+ my ($first, $last);
+ eval {
+ my $lim=0;
+ for ($MAX_INT-10 .. $MAX_INT+$ii) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100); # Protect against integer wrap
+ }
+ };
+ if ($ii <= 0) {
+ ok(! $@, 'Upper bound accepted: ' . ($MAX_INT+$ii));
+ is($first, $MAX_INT-10, 'Lower bound okay');
+ is($last, $MAX_INT+$ii, 'Upper bound okay');
+ } else {
+ ok($@, 'Upper bound rejected: ' . ($MAX_INT+$ii));
+ }
+}
+
+foreach my $ii (-3 .. 3) {
+ my ($first, $last);
+ eval {
+ my $lim=0;
+ for ($MAX_INT+$ii .. $MAX_INT) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100);
+ }
+ };
+ if ($ii <= 0) {
+ ok(! $@, 'Lower bound accepted: ' . ($MAX_INT+$ii));
+ is($first, $MAX_INT+$ii, 'Lower bound okay');
+ is($last, $MAX_INT, 'Upper bound okay');
+ } else {
+ ok($@, 'Lower bound rejected: ' . ($MAX_INT+$ii));
+ }
+}
+
+{
+ my $first;
+ eval {
+ my $lim=0;
+ for ($MAX_INT .. $MAX_INT-1) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100);
+ }
+ };
+ ok(! $@, 'Range accepted');
+ ok(! defined($first), 'Range ineffectual');
+}
+
+foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
+ eval {
+ my $lim=0;
+ for ($MAX_INT-10 .. $ii) {
+ last if ($lim++ > 100);
+ }
+ };
+ ok($@, 'Upper bound rejected: ' . $ii);
+}
+
+# Test lower range limit
+my $MIN_INT = -1-$MAX_INT;
+
+if (! $Config{d_nv_preserves_uv}) {
+ # $MIN_INT needs adjustment when IV won't fit into an NV
+ my $NV = $MIN_INT - 1;
+ my $OFFSET = 1;
+ while (($NV + $OFFSET) == $MIN_INT) {
+ $OFFSET++
+ }
+ $MIN_INT += $OFFSET;
+}
+
+foreach my $ii (-3 .. 3) {
+ my ($first, $last);
+ eval {
+ my $lim=0;
+ for ($MIN_INT+$ii .. $MIN_INT+10) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100);
+ }
+ };
+ if ($ii >= 0) {
+ ok(! $@, 'Lower bound accepted: ' . ($MIN_INT+$ii));
+ is($first, $MIN_INT+$ii, 'Lower bound okay');
+ is($last, $MIN_INT+10, 'Upper bound okay');
+ } else {
+ ok($@, 'Lower bound rejected: ' . ($MIN_INT+$ii));
+ }
+}
+
+foreach my $ii (-3 .. 3) {
+ my ($first, $last);
+ eval {
+ my $lim=0;
+ for ($MIN_INT .. $MIN_INT+$ii) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100);
+ }
+ };
+ if ($ii >= 0) {
+ ok(! $@, 'Upper bound accepted: ' . ($MIN_INT+$ii));
+ is($first, $MIN_INT, 'Lower bound okay');
+ is($last, $MIN_INT+$ii, 'Upper bound okay');
+ } else {
+ ok($@, 'Upper bound rejected: ' . ($MIN_INT+$ii));
+ }
+}
+
+{
+ my $first;
+ eval {
+ my $lim=0;
+ for ($MIN_INT+1 .. $MIN_INT) {
+ if (! defined($first)) {
+ $first = $_;
+ }
+ $last = $_;
+ last if ($lim++ > 100);
+ }
+ };
+ ok(! $@, 'Range accepted');
+ ok(! defined($first), 'Range ineffectual');
+}
+
+foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
+ eval {
+ my $lim=0;
+ for (-$ii .. $MIN_INT+10) {
+ last if ($lim++ > 100);
+ }
+ };
+ ok($@, 'Lower bound rejected: ' . -$ii);
+}
+
+# EOF
End of Patch.
