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.