In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/89d1beed7e8ba85f11b6862ff90c085871cda880?hp=8732b8db3483bef4eb0996dd7fd2f7c20bf61637>
- Log ----------------------------------------------------------------- commit 89d1beed7e8ba85f11b6862ff90c085871cda880 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 15 06:41:17 2014 -0800 Spell behaviour consistently in perlsub We had six instances without U, and two with it. M pod/perlsub.pod commit 6edcbed6404ee551719c9a49397baea538aae7cc Author: Daniel Dragan <[email protected]> Date: Tue May 20 03:23:01 2014 -0400 make debugging easier in memory allocator code in perl.c and util.c -show intermediate values to make C debugging easier -Perl_safesysfree overwrote var where with a different value, this caused alot of confusion for me of trying to hunt for a pointer from a stack trace with conditional breakpoints, so don't change var where in an unoptimized build -in Perl_safesysrealloc and Perl_safesysmalloc provide 1 exit path, so the returned value is easily seen and BPed on unoptimized builds M perl.c M util.c commit 1f9498d0e14a8f9d5a95c29b732bb33bb3c669d8 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 15 06:34:22 2014 -0800 Deparse.t: To-do test for #115066 M lib/B/Deparse.t ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.t | 14 +++++++++++++- perl.c | 7 +++++-- pod/perlsub.pod | 4 ++-- util.c | 37 ++++++++++++++++++++++++------------- 4 files changed, 44 insertions(+), 18 deletions(-) diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 75255cc..bdc54f4 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -13,7 +13,7 @@ use warnings; use strict; use Test::More; -my $tests = 27; # not counting those in the __DATA__ section +my $tests = 28; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -366,6 +366,18 @@ sub BEGIN { EOCODJ } +# [perl #115066] +$::TODO = ' '; +my $prog = 'use constant FOO => do { 1 }; no overloading; die'; +$a = readpipe qq`$^X $path "-MO=-qq,Deparse" -e "$prog" 2>&1`; +is($a, <<'EOCODK', '[perl #115066] use statements accidentally nested'); +use constant ('FOO', do { + 1; +}); +no overloading; +die; +EOCODK + done_testing($tests); __DATA__ diff --git a/perl.c b/perl.c index a5f1592..eb875fc 100644 --- a/perl.c +++ b/perl.c @@ -1364,8 +1364,11 @@ perl_free(pTHXx) "free this thread's memory\n"); PL_debug &= ~ DEBUG_m_FLAG; } - while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)) - safesysfree(PERL_MEMORY_DEBUG_HEADER_SIZE + (char *)(aTHXx->Imemory_debug_header.next)); + while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)){ + char * next = (char *)(aTHXx->Imemory_debug_header.next); + Malloc_t ptr = PERL_MEMORY_DEBUG_HEADER_SIZE + next; + safesysfree(ptr); + } PL_debug = old_debug; } } diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 10eedf5..75d92aa 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -239,7 +239,7 @@ your subroutine's name. return($x * __SUB__->( $x - 1 ) ); }; -The behaviour of C<__SUB__> within a regex code block (such as C</(?{...})/>) +The behavior of C<__SUB__> within a regex code block (such as C</(?{...})/>) is subject to change. Subroutines whose names are in all upper case are reserved to the Perl @@ -897,7 +897,7 @@ to safely reuse $_ in a subroutine. B<WARNING>: Localization of tied arrays and hashes does not currently work as described. This will be fixed in a future release of Perl; in the meantime, avoid -code that relies on any particular behaviour of localising tied arrays +code that relies on any particular behavior of localising tied arrays or hashes (localising individual elements is still okay). See L<perl58delta/"Localising Tied Arrays and Hashes Is Broken"> for more details. diff --git a/util.c b/util.c index f9ca306..4ee17c2 100644 --- a/util.c +++ b/util.c @@ -172,14 +172,17 @@ Perl_safesysmalloc(MEM_SIZE size) #endif ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); + ret: return ptr; } else { #ifndef ALWAYS_NEED_THX dTHX; #endif - if (PL_nomemok) - return NULL; + if (PL_nomemok){ + ptr = NULL; + goto ret; + } else { croak_no_mem(); } @@ -207,11 +210,14 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) if (!size) { safesysfree(where); - return NULL; + ptr = NULL; + goto ret; } - if (!where) - return safesysmalloc(size); + if (!where) { + ptr = safesysmalloc(size); + goto ret; + } #ifdef USE_MDH where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); size += PERL_MEMORY_DEBUG_HEADER_SIZE; @@ -293,14 +299,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) if (ptr != NULL) { + ret: return ptr; } else { #ifndef ALWAYS_NEED_THX dTHX; #endif - if (PL_nomemok) - return NULL; + if (PL_nomemok){ + ptr = NULL; + goto ret; + } else { croak_no_mem(); } @@ -319,10 +328,10 @@ Perl_safesysfree(Malloc_t where) DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++)); if (where) { #ifdef USE_MDH - where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); + Malloc_t where_intrn = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); { struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)where; + = (struct perl_memory_debug_header *)where_intrn; # ifdef MDH_HAS_SIZE const MEM_SIZE size = header->size; @@ -352,21 +361,23 @@ Perl_safesysfree(Malloc_t where) maybe_protect_ro(header->prev); maybe_protect_rw(header); # ifdef PERL_POISON - PoisonNew(where, size, char); + PoisonNew(where_intrn, size, char); # endif /* Trigger the duplicate free warning. */ header->next = NULL; # endif # ifdef PERL_DEBUG_READONLY_COW - if (munmap(where, size)) { + if (munmap(where_intrn, size)) { perror("munmap failed"); abort(); } # endif } -#endif +#else + Malloc_t where_intrn = where; +#endif /* USE_MDH */ #ifndef PERL_DEBUG_READONLY_COW - PerlMem_free(where); + PerlMem_free(where_intrn); #endif } } -- Perl5 Master Repository
