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.