Change 33940: Integrate:

Change 33940 by davem@davem-pigeon 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" <robertmay@cpan.org>
	Date: Sun, 3 Feb 2008 13:11:57 +0530
	Message-ID: <54bdc7510802022341r3654d32dva26ef04bd9fa04b7@mail.gmail.com>
	
	[ 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 <ben@morrow.me.uk>
	Date: Fri, 8 Feb 2008 13:50:09 +0000
	Message-ID: <20080208135008.GA3885@osiris.mauzo.dyndns.org>

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.

• Change 33940: Integrate: by Dave Mitchell