Change 33940 by [EMAIL PROTECTED] on 2008/05/27 20:57:19
Integrate:
[ 33238]
Adapt Safe innards to older (XS) versions of version.pm
[ 33248]
Remove redundant check
[ 33254]
Subject: [PATCH] win32_async_check() doesn't loop enough.
From: "Robert May" <[EMAIL PROTECTED]>
Date: Sun, 3 Feb 2008 13:11:57 +0530
Message-ID: <[EMAIL PROTECTED]>
[ 33261]
Remove an unneeded if statement.
[ 33265]
[perl #49472] Attributes + Unkown Error
An errored attribute sub still processes the attributes,
which require's attribute.pm, so make sure the error state is
passed to the new require
[ 33278]
Fix test to pass en 5.6.2 (unpack is needed by version.pm there)
[ 33280]
Subject: [PATCH] Re: Unwanted warnings from "PerlIO::scalar"
From: Ben Morrow <[EMAIL PROTECTED]>
Date: Fri, 8 Feb 2008 13:50:09 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.10/perl/ext/PerlIO/scalar/scalar.xs#3 integrate
... //depot/maint-5.10/perl/ext/PerlIO/t/scalar.t#2 integrate
... //depot/maint-5.10/perl/ext/Safe/t/safeload.t#2 integrate
... //depot/maint-5.10/perl/perlio.c#6 integrate
... //depot/maint-5.10/perl/t/comp/require.t#2 integrate
... //depot/maint-5.10/perl/toke.c#5 integrate
... //depot/maint-5.10/perl/win32/win32.c#7 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/PerlIO/scalar/scalar.xs#3 (text) ====
Index: perl/ext/PerlIO/scalar/scalar.xs
--- perl/ext/PerlIO/scalar/scalar.xs#2~33161~ 2008-01-31 14:14:13.000000000
-0800
+++ perl/ext/PerlIO/scalar/scalar.xs 2008-05-27 13:57:19.000000000 -0700
@@ -31,8 +31,9 @@
return -1;
}
s->var = SvREFCNT_inc(SvRV(arg));
- if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
- (void)SvPV_nolen(s->var);
+ SvGETMAGIC(s->var);
+ if (!SvPOK(s->var) && SvOK(s->var))
+ (void)SvPV_nomg_const_nolen(s->var);
}
else {
s->var =
==== //depot/maint-5.10/perl/ext/PerlIO/t/scalar.t#2 (text) ====
Index: perl/ext/PerlIO/t/scalar.t
--- perl/ext/PerlIO/t/scalar.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/PerlIO/t/scalar.t 2008-05-27 13:57:19.000000000 -0700
@@ -18,7 +18,7 @@
$| = 1;
-use Test::More tests => 51;
+use Test::More tests => 55;
my $fh;
my $var = "aaa\n";
@@ -113,6 +113,47 @@
is($warn, 0, "no warnings when writing to an undefined scalar");
}
+{
+ use warnings;
+ my $warn = 0;
+ local $SIG{__WARN__} = sub { $warn++ };
+ for (1..2) {
+ open my $fh, '>', \my $scalar;
+ close $fh;
+ }
+ is($warn, 0, "no warnings when reusing a lexical");
+}
+
+{
+ use warnings;
+ my $warn = 0;
+ local $SIG{__WARN__} = sub { $warn++ };
+
+ my $fetch = 0;
+ {
+ package MgUndef;
+ sub TIESCALAR { bless [] }
+ sub FETCH { $fetch++; return undef }
+ }
+ tie my $scalar, MgUndef;
+
+ open my $fh, '<', \$scalar;
+ close $fh;
+ is($warn, 0, "no warnings reading a magical undef scalar");
+ is($fetch, 1, "FETCH only called once");
+}
+
+{
+ use warnings;
+ my $warn = 0;
+ local $SIG{__WARN__} = sub { $warn++ };
+ my $scalar = 3;
+ undef $scalar;
+ open my $fh, '<', \$scalar;
+ close $fh;
+ is($warn, 0, "no warnings reading an undef, allocated scalar");
+}
+
my $data = "a non-empty PV";
$data = undef;
open(MEM, '<', \$data) or die "Fail: $!\n";
==== //depot/maint-5.10/perl/ext/Safe/t/safeload.t#2 (text) ====
Index: perl/ext/Safe/t/safeload.t
--- perl/ext/Safe/t/safeload.t#1~33921~ 2008-05-24 09:32:36.000000000 -0700
+++ perl/ext/Safe/t/safeload.t 2008-05-27 13:57:19.000000000 -0700
@@ -25,6 +25,6 @@
plan(tests => 1);
my $c = new Safe;
-$c->permit(qw(require caller));
+$c->permit(qw(require caller entereval unpack));
my $r = $c->reval(q{ use version; 1 });
ok( defined $r, "Can load version.pm in a Safe compartment" ) or diag $@;
==== //depot/maint-5.10/perl/perlio.c#6 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#5~33614~ 2008-03-31 09:59:07.000000000 -0700
+++ perl/perlio.c 2008-05-27 13:57:19.000000000 -0700
@@ -3427,9 +3427,7 @@
#ifdef STDIO_PTR_LVALUE
PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */
#ifdef STDIO_PTR_LVAL_SETS_CNT
- if (PerlSIO_get_cnt(stdio) != (cnt)) {
- assert(PerlSIO_get_cnt(stdio) == (cnt));
- }
+ assert(PerlSIO_get_cnt(stdio) == (cnt));
#endif
#if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
/*
@@ -4132,10 +4130,8 @@
if (!b->buf)
PerlIO_get_base(f);
b->ptr = ptr;
- if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) {
- assert(PerlIO_get_cnt(f) == cnt);
- assert(b->ptr >= b->buf);
- }
+ assert(PerlIO_get_cnt(f) == cnt);
+ assert(b->ptr >= b->buf);
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
}
==== //depot/maint-5.10/perl/t/comp/require.t#2 (xtext) ====
Index: perl/t/comp/require.t
--- perl/t/comp/require.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/comp/require.t 2008-05-27 13:57:19.000000000 -0700
@@ -15,7 +15,7 @@
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 49;
+my $total_tests = 50;
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
print "1..$total_tests\n";
@@ -258,6 +258,20 @@
}
}
+# [perl #49472] Attributes + Unkown Error
+
+{
+ do_require
+ 'use strict;sub MODIFY_CODE_ATTRIBUTE{} sub f:Blah {$nosuchvar}';
+ my $err = $@;
+ $err .= "\n" unless $err =~ /\n$/;
+ unless ($err =~ /Global symbol "\$nosuchvar" requires /) {
+ $err =~ s/^/# /mg;
+ print "${err}not ";
+ }
+ print "ok ", ++$i, " [perl #49472]\n";
+}
+
##########################################
# What follows are UTF-8 specific tests. #
# Add generic tests before this point. #
==== //depot/maint-5.10/perl/toke.c#5 (text) ====
Index: perl/toke.c
--- perl/toke.c#4~33443~ 2008-03-05 04:02:54.000000000 -0800
+++ perl/toke.c 2008-05-27 13:57:19.000000000 -0700
@@ -692,6 +692,7 @@
#else
parser->nexttoke = 0;
#endif
+ parser->error_count = oparser ? oparser->error_count : 0;
parser->copline = NOLINE;
parser->lex_state = LEX_NORMAL;
parser->expect = XSTATE;
==== //depot/maint-5.10/perl/win32/win32.c#7 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c#6~33802~ 2008-05-10 07:15:40.000000000 -0700
+++ perl/win32/win32.c 2008-05-27 13:57:19.000000000 -0700
@@ -2151,7 +2151,7 @@
timeout += ticks;
}
while (1) {
- DWORD result =
MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks,
QS_POSTMESSAGE|QS_TIMER);
+ DWORD result =
MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks,
QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
if (resultp)
*resultp = result;
if (result == WAIT_TIMEOUT) {
End of Patch.
