Change 33939: Revert part of #31039
Change 33939 by [EMAIL PROTECTED] on 2008/05/27 15:19:07 Revert part of #31039 Affected files ... ... //depot/perl/Configure#693 edit Differences ... //depot/perl/Configure#693 (xtext) Index: perl/Configure --- perl/Configure#692~33887~ 2008-05-20 08:30:30.0 -0700 +++ perl/Configure 2008-05-27 08:19:07.0 -0700 @@ -25,7 +25,7 @@ # $Id: Head.U 6 2006-08-25 22:21:46Z rmanfredi $ # -# Generated on Tue May 20 17:29:22 CEST 2008 [metaconfig 3.5 PL0] +# Generated on Tue May 27 17:17:47 CEST 2008 [metaconfig 3.5 PL0] # (with additional metaconfig patches by [EMAIL PROTECTED]) cat >c1$$ <&4 <
Change 33940: Integrate:
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 + 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.0 -0800 +++ perl/ext/PerlIO/scalar/scalar.xs2008-05-27 13:57:19.0 -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.0 -0800 +++ perl/ext/PerlIO/t/scalar.t 2008-05-27 13:57:19.0 -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.0 -0700 +++ perl/ext/Safe/t/safeload.t 2008-05-27 13:57:19.0 -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.0 -0700 +++ perl/perlio.c 2008-05-27 13:57:19.0 -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 >
Change 33941: Integrate:
Change 33941 by [EMAIL PROTECTED] on 2008/05/27 22:58:13 Integrate: [ 33297] Subject: [PATCH] Read-only variable tests From: "Jerry D. Hedden" <[EMAIL PROTECTED]> Date: Fri, 8 Feb 2008 14:06:41 -0500 Message-ID: <[EMAIL PROTECTED]> with one less TODO test [ 33311] Subject: Re: [perl #50706] %^H affecting outside file scopes From: Rick Delaney <[EMAIL PROTECTED]> Date: Tue, 12 Feb 2008 14:05:22 -0500 Message-ID: <[EMAIL PROTECTED]> [ 33312] Add missing file to MANIFEST, to go with change #33311 [ 33313] Subject: [PATCH t/op/pat.t] Re: [perl #50496] Bug Report: 'keys %+' does not return the correct keys. From: Abigail <[EMAIL PROTECTED]> Date: Thu, 7 Feb 2008 17:53:30 +0100 Message-ID: <[EMAIL PROTECTED]> with tweaks (one more test marked TODO) [ 33317] Typo catch, by Abigail [ 33322] Correctly reference count the hints hash [ 33323] Fix macro name in comment [ 33324] Fix perlbug 50114 and document what the code does a bit better [ 33325] Fix bug 50496 -- regcomp.c=~s/lastcloseparen/lastparen/g -- lastcloseparen is literally the index of the last paren closed -- lastparen is index of the highest index paren that has been closed. In nested parens, they will be completely different. 'ab'=~/(a(b))/ will have: lastparen = 2, lastcloseparen = 1 'ab'=~/(a)(b)/ will have: lastparen = lastcloseparen = 2 [ 33327] Subject: [ patch ] silence 2 possibly uninitialized vars From: Jim Cromie <[EMAIL PROTECTED]> Date: Sat, 16 Feb 2008 18:02:19 -0700 Message-ID: <[EMAIL PROTECTED]> Affected files ... ... //depot/maint-5.10/perl/MANIFEST#26 integrate ... //depot/maint-5.10/perl/lib/Internals.t#2 integrate ... //depot/maint-5.10/perl/op.c#10 integrate ... //depot/maint-5.10/perl/pp_ctl.c#14 integrate ... //depot/maint-5.10/perl/regcomp.c#13 integrate ... //depot/maint-5.10/perl/t/lib/Sans_mypragma.pm#1 branch ... //depot/maint-5.10/perl/t/lib/mypragma.t#2 integrate ... //depot/maint-5.10/perl/t/op/pat.t#9 integrate ... //depot/maint-5.10/perl/t/op/re_tests#4 integrate ... //depot/maint-5.10/perl/toke.c#6 integrate Differences ... //depot/maint-5.10/perl/MANIFEST#26 (text) Index: perl/MANIFEST --- perl/MANIFEST#25~33921~ 2008-05-24 09:32:36.0 -0700 +++ perl/MANIFEST 2008-05-27 15:58:13.0 -0700 @@ -3582,6 +3582,7 @@ t/lib/sample-tests/too_manyTest data for Test::Harness t/lib/sample-tests/vms_nit Test data for Test::Harness t/lib/sample-tests/with_comments Test data for Test::Harness +t/lib/Sans_mypragma.pm Test module for t/lib/mypragma.t t/lib/strict/refs Tests of "use strict 'refs'" for strict.t t/lib/strict/subs Tests of "use strict 'subs'" for strict.t t/lib/strict/vars Tests of "use strict 'vars'" for strict.t //depot/maint-5.10/perl/lib/Internals.t#2 (text) Index: perl/lib/Internals.t --- perl/lib/Internals.t#1~32694~ 2007-12-22 01:23:09.0 -0800 +++ perl/lib/Internals.t2008-05-27 15:58:13.0 -0700 @@ -7,39 +7,146 @@ } } -use Test::More tests => 33; +use Test::More tests => 74; +my $ro_err = qr/^Modification of a read-only value attempted/; + +### Read-only scalar my $foo; -my @foo; -my %foo; ok( !Internals::SvREADONLY $foo ); +$foo = 3; +is($foo, 3); + ok( Internals::SvREADONLY $foo, 1 ); ok( Internals::SvREADONLY $foo ); +eval { $foo = 'foo'; }; +like($@, $ro_err, q/Can't modify read-only scalar/); +eval { undef($foo); }; +like($@, $ro_err, q/Can't undef read-only scalar/); +is($foo, 3); + ok( !Internals::SvREADONLY $foo, 0 ); ok( !Internals::SvREADONLY $foo ); +$foo = 'foo'; +is($foo, 'foo'); + +### Read-only array +my @foo; ok( !Internals::SvREADONLY @foo ); [EMAIL PROTECTED] = (1..3); +is(scalar(@foo), 3); +is($foo[2], 3); + ok( Internals::SvREADONLY @foo, 1 ); ok( Internals::SvREADONLY @foo ); +eval { undef(@foo); }; +like($@, $ro_err, q/Can't undef read-only array/); +eval { delete($foo[2]); }; +like($@, $ro_err, q/Can't delete from read-only array/); +eval { shift(@foo); }; +like($@, $ro_err, q/Can't shift read-only array/); +eval { push(@foo, 'bork'); }; +like($@, $ro_err, q/Can't push onto read-only array/); +eval { @foo = qw/foo bar/; }; +like($@, $ro_err, q/Can't reassign read-only array/); + ok( !Internals::SvREADONLY @foo, 0 ); ok( !Internals::SvREADONLY @foo ); +eval { @foo = qw/foo bar/; }; +is(scalar(@foo), 2); +is($foo[1], 'bar'); + +### Read-only array element ok( !Internals::SvREADONLY $foo[2] ); +$foo[2] = 'baz'; +is($foo[2], 'baz'); + ok( Internals::SvREADONLY $foo[2], 1 ); ok( Interna
Change 33942: Integrate:
Change 33942 by [EMAIL PROTECTED] on 2008/05/28 01:21:26 Integrate: [ 7] Setting the f flag on length causes the op to be constant folded. [ 33342] fix variable names in 'ununit var' warnings in evals [ 33363] Subject: [PATCH] B::Debug enhancements From: "Reini Urban" <[EMAIL PROTECTED]> Date: Fri, 22 Feb 2008 09:52:32 +0100 Message-ID: <[EMAIL PROTECTED]> [ 33367] Avoid a segfault case in MRO code, based on : Subject: [perl #51092] [PATCH] Segfault when calling ->next::method on non-existing package From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]> Date: Thu, 21 Feb 2008 20:29:42 -0800 Message-ID: <[EMAIL PROTECTED]> [ 33369] Ensure that constant folding runs with IN_PERL_RUNTIME true, by copying the current compiling cop to a different address. This ensures that lexical hints are correctly honoured, and allows us to fold sprintf. [ 33377] If we have malloced_size() available, then avoid rounding up the string to the next (guessed) plausible alignment size, and instead find out how much memory was actually allocated, so that we can set this in the scalar's SvLEN(). This way, sv_grow() will be called far less often. [ 33378] In Perl_sv_usepvn_flags(), with MYMALLOC, use the actual malloc()ed size for SvLEN(), rather than an estimate. [ 33379] If the C library provides malloc_size(), we can use that in the same places as Perl's malloced_size(), except that we need to be careful of any PERL_TRACK_MEMPOOL manipulations in force. Wrap both as Perl_safesysmalloc_size(), to give a consistent name and interface. [ 33380] Fix preprocessor syntax [ 33383] Comment on why I don't think changing Perl_safesysmalloc_size() in av.c analagous to the change in sv.c is a good idea. [It's not a language design issue, so sadly I can't get a talk out of it. Or is that fortunately? :-)] [ 33389] Add Perl_malloc_good_size to malloc.c. (A routine that rounds up the passed in request to the size that will actually be allocated. It's the same interface as Darwin already provides with malloc_good_size().) [ 33390] Use malloc_good_size() to round up the size of requested arenas to the size that will actually be allocated, to squeeze last few bytes into use. Affected files ... ... //depot/maint-5.10/perl/av.c#4 integrate ... //depot/maint-5.10/perl/embed.fnc#10 integrate ... //depot/maint-5.10/perl/embed.h#6 integrate ... //depot/maint-5.10/perl/ext/B/B/Debug.pm#3 integrate ... //depot/maint-5.10/perl/handy.h#5 integrate ... //depot/maint-5.10/perl/hv.c#3 integrate ... //depot/maint-5.10/perl/makedef.pl#2 integrate ... //depot/maint-5.10/perl/malloc.c#3 integrate ... //depot/maint-5.10/perl/mro.c#5 integrate ... //depot/maint-5.10/perl/op.c#11 integrate ... //depot/maint-5.10/perl/opcode.h#2 integrate ... //depot/maint-5.10/perl/opcode.pl#3 integrate ... //depot/maint-5.10/perl/perl.h#12 integrate ... //depot/maint-5.10/perl/proto.h#8 integrate ... //depot/maint-5.10/perl/sv.c#15 integrate ... //depot/maint-5.10/perl/t/lib/warnings/7fatal#2 integrate ... //depot/maint-5.10/perl/t/lib/warnings/9uninit#4 integrate ... //depot/maint-5.10/perl/t/mro/next_edgecases.t#2 integrate Differences ... //depot/maint-5.10/perl/av.c#4 (text) Index: perl/av.c --- perl/av.c#3~33614~ 2008-03-31 09:59:07.0 -0700 +++ perl/av.c 2008-05-27 18:21:26.0 -0700 @@ -117,8 +117,22 @@ IV itmp; #endif -#ifdef MYMALLOC - newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; +#ifdef Perl_safesysmalloc_size + /* Whilst it would be quite possible to move this logic around + (as I did in the SV code), so as to set AvMAX(av) early, + based on calling Perl_safesysmalloc_size() immediately after + allocation, I'm not convinced that it is a great idea here. + In an array we have to loop round setting everything to + &PL_sv_undef, which means writing to memory, potentially lots + of it, whereas for the SV buffer case we don't touch the + "bonus" memory. So there there is no cost in telling the + world about it, whereas here we have to do work before we can + tell the world about it, and that work involves writing to + memory that might never be read. So, I feel, better to keep + the current lazy system of only writing to it if our caller + has a need for more space. NWC */ + newmax =