Change 26109 by [EMAIL PROTECTED] on 2005/11/13 11:34:21
Integrate:
[ 24718]
Subject: [perl #36193] crash in Perl_yyerror due to missing check for
NULL
From: "Todd C. Miller" (via RT) <[EMAIL PROTECTED]>
Date: 6 Jun 2005 23:24:28 -0000
Message-ID: <[EMAIL PROTECTED]>
[ 25137]
Subject: [PATCH] Error in earlier patch in sv.c
From: Robin Barker <[EMAIL PROTECTED]>
Date: Wed, 13 Jul 2005 17:29:48 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 25194]
Subject: [PATCH] lvalue-subs returning elements of tied hashes/arrays
From: Tassilo von Parseval <[EMAIL PROTECTED]>
Date: Wed, 20 Jul 2005 10:43:11 +0200
Message-id: <[EMAIL PROTECTED]>
[ 25319]
Subject: [PATCH blead] Re: [perl #36959] List Constructor Operator -
Undefined Values
From: Rick Delaney <[EMAIL PROTECTED]>
Date: Sun, 21 Aug 2005 15:09:57 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 25329]
No need to manually set the reference count of a new IO to 1.
[ 25358]
Subject: Re: Fw: Tied hash numeric values are rounded off under Perl
v5.8.6
From: Yitzchak Scott-Thoennes <[EMAIL PROTECTED]>
Date: Fri, 2 Sep 2005 00:05:52 -0700
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/gv.c#56 integrate
... //depot/maint-5.8/perl/mg.c#88 integrate
... //depot/maint-5.8/perl/pp_ctl.c#104 integrate
... //depot/maint-5.8/perl/pp_hot.c#86 integrate
... //depot/maint-5.8/perl/sv.c#192 integrate
... //depot/maint-5.8/perl/t/op/range.t#6 integrate
... //depot/maint-5.8/perl/t/op/sprintf.t#10 integrate
... //depot/maint-5.8/perl/t/op/sub_lval.t#4 integrate
... //depot/maint-5.8/perl/t/op/tie.t#14 integrate
... //depot/maint-5.8/perl/toke.c#99 integrate
Differences ...
==== //depot/maint-5.8/perl/gv.c#56 (text) ====
Index: perl/gv.c
--- perl/gv.c#55~25673~ Fri Sep 30 10:13:04 2005
+++ perl/gv.c Sun Nov 13 03:34:21 2005
@@ -1208,7 +1208,10 @@
IO * const io = (IO*)NEWSV(0,0);
sv_upgrade((SV *)io,SVt_PVIO);
- SvREFCNT(io) = 1;
+ /* This used to read SvREFCNT(io) = 1;
+ It's not clear why the reference count needed an explicit reset. NWC
+ */
+ assert (SvREFCNT(io) == 1);
SvOBJECT_on(io);
/* Clear the stashcache because a new IO could overrule a package name */
hv_clear(PL_stashcache);
==== //depot/maint-5.8/perl/mg.c#88 (text) ====
Index: perl/mg.c
--- perl/mg.c#87~25714~ Sat Oct 8 08:52:58 2005
+++ perl/mg.c Sun Nov 13 03:34:21 2005
@@ -2707,8 +2707,16 @@
SvFLAGS(sv) |= mgs->mgs_flags;
else
mg_magical(sv);
- if (SvGMAGICAL(sv))
- SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+ if (SvGMAGICAL(sv)) {
+ /* downgrade public flags to private,
+ and discard any other private flags */
+
+ U32 public = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
+ if (public) {
+ SvFLAGS(sv) &= ~( public | SVp_IOK|SVp_NOK|SVp_POK );
+ SvFLAGS(sv) |= ( public << PRIVSHIFT );
+ }
+ }
}
mgs->mgs_sv = NULL; /* mark the MGS structure as restored */
==== //depot/maint-5.8/perl/pp_ctl.c#104 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#103~25714~ Sat Oct 8 08:52:58 2005
+++ perl/pp_ctl.c Sun Nov 13 03:34:21 2005
@@ -1737,6 +1737,8 @@
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
dPOPss;
SV *right = (SV*)cx->blk_loop.iterary;
+ SvGETMAGIC(sv);
+ SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
(SvOK(right) && SvNV(right) >= IV_MAX))
==== //depot/maint-5.8/perl/pp_hot.c#86 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#85~25673~ Fri Sep 30 10:13:04 2005
+++ perl/pp_hot.c Sun Nov 13 03:34:21 2005
@@ -2444,7 +2444,10 @@
MARK = newsp + 1;
EXTEND_MORTAL(1);
if (MARK == SP) {
- if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+ /* Temporaries are bad unless they happen to be elements
+ * of a tied hash or array */
+ if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
+ !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
==== //depot/maint-5.8/perl/sv.c#192 (text) ====
Index: perl/sv.c
--- perl/sv.c#191~26098~ Sat Nov 12 08:44:12 2005
+++ perl/sv.c Sun Nov 13 03:34:21 2005
@@ -8778,9 +8778,11 @@
}
if (!asterisk)
+ {
if( *q == '0' )
fill = *q++;
EXPECT_NUMBER(q, width);
+ }
#ifdef CHECK_FORMAT
if ((*q == 'p') && left) {
==== //depot/maint-5.8/perl/t/op/range.t#6 (xtext) ====
Index: perl/t/op/range.t
--- perl/t/op/range.t#5~22550~ Mon Mar 22 09:26:06 2004
+++ perl/t/op/range.t Sun Nov 13 03:34:21 2005
@@ -7,7 +7,7 @@
use Config;
-print "1..37\n";
+print "1..45\n";
print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
@@ -140,3 +140,51 @@
@foo=(); push @foo, $_ for undef..undef;
print join(":", map "[$_]", @foo) eq '[]' ? "ok 37\n" : "not ok 37\n";
+
+# again with magic
+{
+ my @a = (1..3);
+ @foo=(); push @foo, $_ for undef..$#a;
+ print join(":", @foo) eq '0:1:2' ? "ok 38\n" : "not ok 38\n";
+}
+{
+ my @a = ();
+ @foo=(); push @foo, $_ for $#a..undef;
+ print join(":", @foo) eq '-1:0' ? "ok 39\n" : "not ok 39\n";
+}
+{
+ local $1;
+ "2" =~ /(.+)/;
+ @foo=(); push @foo, $_ for undef..$1;
+ print join(":", @foo) eq '0:1:2' ? "ok 40\n" : "not ok 40\n";
+}
+{
+ local $1;
+ "-2" =~ /(.+)/;
+ @foo=(); push @foo, $_ for $1..undef;
+ print join(":", @foo) eq '-2:-1:0' ? "ok 41\n" : "not ok 41\n";
+}
+{
+ local $1;
+ "B" =~ /(.+)/;
+ @foo=(); push @foo, $_ for undef..$1;
+ print join(":", map "[$_]", @foo) eq '[]' ? "ok 42\n" : "not ok 42\n";
+}
+{
+ local $1;
+ "B" =~ /(.+)/;
+ @foo=(); push @foo, $_ for ""..$1;
+ print join(":", map "[$_]", @foo) eq '[]' ? "ok 43\n" : "not ok 43\n";
+}
+{
+ local $1;
+ "B" =~ /(.+)/;
+ @foo=(); push @foo, $_ for $1..undef;
+ print join(":", map "[$_]", @foo) eq '' ? "ok 44\n" : "not ok 44\n";
+}
+{
+ local $1;
+ "B" =~ /(.+)/;
+ @foo=(); push @foo, $_ for $1.."";
+ print join(":", map "[$_]", @foo) eq '' ? "ok 45\n" : "not ok 45\n";
+}
==== //depot/maint-5.8/perl/t/op/sprintf.t#10 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#9~25467~ Sun Sep 18 07:03:33 2005
+++ perl/t/op/sprintf.t Sun Nov 13 03:34:21 2005
@@ -386,3 +386,4 @@
>%4$K %d< >[45, 67]< >%4$K 45 INVALID<
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
+>%*2$1d< >[12, 3]< >%*2$1d INVALID<
==== //depot/maint-5.8/perl/t/op/sub_lval.t#4 (xtext) ====
Index: perl/t/op/sub_lval.t
--- perl/t/op/sub_lval.t#3~18850~ Fri Mar 7 12:38:51 2003
+++ perl/t/op/sub_lval.t Sun Nov 13 03:34:21 2005
@@ -1,4 +1,4 @@
-print "1..67\n";
+print "1..71\n";
BEGIN {
chdir 't' if -d 't';
@@ -530,8 +530,51 @@
print "not " unless join(':', @ary) eq "1:2:6";
print "ok 64\n";
+# check that an element of a tied hash/array can be assigned to via lvalueness
+
+package Tie_Hash;
+
+our ($key, $val);
+sub TIEHASH { bless \my $v => __PACKAGE__ }
+sub STORE { ($key, $val) = @_[1,2] }
+
+package main;
+sub lval_tie_hash : lvalue {
+ tie my %t => 'Tie_Hash';
+ $t{key};
+}
+
+eval { lval_tie_hash() = "value"; };
+
+print "# element of tied hash: [EMAIL PROTECTED] " if $@;
+print "ok 65\n";
+
+print "not " if "$Tie_Hash::key-$Tie_Hash::val" ne "key-value";
+print "ok 66\n";
+
+
+package Tie_Array;
+
+our @val;
+sub TIEARRAY { bless \my $v => __PACKAGE__ }
+sub STORE { $val[ $_[1] ] = $_[2] }
+
+package main;
+sub lval_tie_array : lvalue {
+ tie my @t => 'Tie_Array';
+ $t[0];
+}
+
+eval { lval_tie_array() = "value"; };
+
+print "# element of tied array: [EMAIL PROTECTED] " if $@;
+print "ok 67\n";
+
+print "not " if $Tie_Array::val[0] ne "value";
+print "ok 68\n";
+
require './test.pl';
-curr_test(65);
+curr_test(69);
TODO: {
local $TODO = 'test explicit return of lval expr';
==== //depot/maint-5.8/perl/t/op/tie.t#14 (xtext) ====
Index: perl/t/op/tie.t
--- perl/t/op/tie.t#13~23259~ Sat Sep 4 12:40:24 2004
+++ perl/t/op/tie.t Sun Nov 13 03:34:21 2005
@@ -540,3 +540,10 @@
not empty
FIRSTKEY
empty
+########
+sub TIESCALAR { bless {} }
+sub FETCH { my $x = 3.3; 1 if 0+$x; $x }
+tie $h, "main";
+print $h,"\n";
+EXPECT
+3.3
==== //depot/maint-5.8/perl/toke.c#99 (text) ====
Index: perl/toke.c
--- perl/toke.c#98~25673~ Fri Sep 30 10:13:04 2005
+++ perl/toke.c Sun Nov 13 03:34:21 2005
@@ -10615,8 +10615,9 @@
if (!yychar || (yychar == ';' && !PL_rsfp))
where = "at EOF";
- else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200
&&
- PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
+ else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
+ PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr &&
+ PL_oldbufptr != PL_bufptr) {
/*
Only for NetWare:
The code below is removed for NetWare because it abends/crashes
on NetWare
@@ -10631,8 +10632,8 @@
context = PL_oldoldbufptr;
contlen = PL_bufptr - PL_oldoldbufptr;
}
- else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
- PL_oldbufptr != PL_bufptr) {
+ else if (PL_oldbufptr && PL_bufptr > PL_oldbufptr &&
+ PL_bufptr - PL_oldbufptr < 200 && PL_oldbufptr != PL_bufptr) {
/*
Only for NetWare:
The code below is removed for NetWare because it abends/crashes
on NetWare
End of Patch.
