Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[PATCH] 1 exit path for returning ptr in Perl_safesysmalloc and Perl_safesysrealloc #14297

Closed
p5pRT opened this issue Dec 3, 2014 · 6 comments

Comments

@p5pRT
Copy link

p5pRT commented Dec 3, 2014

Migrated from rt.perl.org#123354 (status was 'resolved')

Searchable as RT123354$

@p5pRT
Copy link
Author

p5pRT commented Dec 3, 2014

From @bulk88

Created by @bulk88

See attached patch. Since goto isn't an option because of
http​://perl5.git.perl.org/perl.git/commit/c62df97fd6a0ef53562060054f04dfeadb67f5f8
for avoiding whitespace changes, just change the whitespace. I didn't
notice that the original patch was applied before, and I didn't notice
it was reverted later, but I *just* noticed half of the original patch
was surviving rebasing for weeks, and went to investigate if it was
applied and found out it was partially reverted. This patch finishes off
the point of having 1 exit path to set a break point.

Perl Info

Flags:
         category=core
         severity=low

Site configuration information for perl 5.21.7:

Configured by Owner at Sat Nov 22 21:54:54 2014.

Summary of my perl5 (revision 5 version 21 subversion 7) configuration:
       Local Commit: 1bce52df028aabe28c20b2d97949e35c17ea811e
       Ancestor: 7072da8afeba4c87ae623cd913e274396ffcf1cd
       Platform:
         osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
         uname=''
         config_args='undef'
         hint=recommended, useposix=true, d_sigaction=undef
         useithreads=define, usemultiplicity=define
         use64bitint=undef, use64bitall=undef, uselongdouble=undef
         usemymalloc=n, bincompat5005=undef
       Compiler:
         cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -G7 -GL
-DWIN32 -D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS
-DPERL_HASH_FUNC_ONE_AT_A_TIME -DNO_MATHOMS -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T',
         optimize='-O1 -MD -Zi -DNDEBUG -G7 -GL',
         cppflags='-DWIN32'
         ccversion='13.10.6030', gccversion='', gccosandvers=''
         intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234,
doublekind=3
         d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8,
longdblkind=0
         ivtype='long', ivsize=4, nvtype='double', nvsize=8, 
Off_t='__int64',
lseeksize=8
         alignbytes=8, prototype=define
       Linker and Libraries:
         ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf
-ltcg  -libpath:"c:\perl521\lib\CORE"  -machine:x86'
         libpth="C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\lib"
         libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
         perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib
winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib
oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
         libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl521.lib
         gnulibc_version=''
       Dynamic Linking:
         dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
         cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-opt:ref,icf -ltcg  -libpath:"c:\perl521\lib\CORE"  -machine:x86'

Locally applied patches:
         ce7a4d57d0acca9f39a84d36d708c4505dfe45ca
         ca0b263f4b167ddf97416f657d79ab5bd3344357
         08919bf863666074243240abbd19cd1a74cc7b74
         b8a043377dbf39548709b107a11e5cc2714c0e9a
         efa855eb5cffb7739616c295dd968d1510efeeb0
         1d47d0b810e26d9a2f9101fb813bd5b3dd332cc9
         3faca062ddb056db54f73fa55b0a9d473675dd33
         0b3e905bda3e75ad948a1213f620656b60807393
         1b1efc719fde05d215e5a13fb38c03e12a3aab08
         1bce52df028aabe28c20b2d97949e35c17ea811e


@INC for perl 5.21.7:
         ..\lib
         C:/perl521/srcnewb4opt/lib
         .


Environment for perl 5.21.7:
         HOME (unset)
         LANG (unset)
         LANGUAGE (unset)
         LD_LIBRARY_PATH (unset)
         LOGDIR (unset)
         PATH=C:\WINDOWS\system32;C:\Program Files\Microsoft Visual Studio
.NET 2003\Vc7\bin;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\IDE;C:\WINDOWS;C:\Program Files\Git\cmd;C:\Program
Files\Microsoft Visual Studio .NET 2003\Common7\Tools\bin;C:\perl\bin
         PERL_BADLANG (unset)
         PERL_JSON_BACKEND=Cpanel::JSON::XS
         PERL_YAML_BACKEND=YAML
         SHELL (unset)








@p5pRT
Copy link
Author

p5pRT commented Dec 3, 2014

From @bulk88

0001-1-exit-path-for-returning-ptr-in-Perl_safesysmalloc-.patch
From d812b16d192ae63f9d8a3fe43ce8037e5e34352c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 3 Dec 2014 04:59:46 -0500
Subject: [PATCH] 1 exit path for returning ptr in Perl_safesysmalloc and
 Perl_safesysrealloc

commit 6edcbed640 goto-ed around an initialization and was partially
reverted in commit c62df97fd6 . This patch restores the intention of
commit 6edcbed640 by having only 1 exit path that will be returning
a pointer (and not croaking).
---
 util.c |  140 +++++++++++++++++++++++++++++++---------------------------------
 1 files changed, 68 insertions(+), 72 deletions(-)

diff --git a/util.c b/util.c
index 056f026..4289451 100644
--- a/util.c
+++ b/util.c
@@ -170,21 +170,20 @@ Perl_safesysmalloc(MEM_SIZE size)
 #ifdef MDH_HAS_SIZE
 	header->size = size;
 #endif
-        ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE);
+	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));
-	return ptr;
-}
+
+    }
     else {
 #ifndef ALWAYS_NEED_THX
 	dTHX;
 #endif
 	if (PL_nomemok)
-	    return NULL;
-	else {
+	    ptr =  NULL;
+	else
 	    croak_no_mem();
-	}
     }
-    NOT_REACHED; /*NOTREACHED*/
+    return ptr;
 }
 
 /* paranoid version of system's realloc() */
@@ -207,105 +206,102 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
     if (!size) {
 	safesysfree(where);
-	return NULL;
+	ptr = NULL;
     }
-
-    if (!where)
-	return safesysmalloc(size);
+    else if (!where) {
+	ptr = safesysmalloc(size);
+    }
+    else {
 #ifdef USE_MDH
-    where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE);
-    size += PERL_MEMORY_DEBUG_HEADER_SIZE;
-    {
-	struct perl_memory_debug_header *const header
-	    = (struct perl_memory_debug_header *)where;
+	where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE);
+	size += PERL_MEMORY_DEBUG_HEADER_SIZE;
+	{
+	    struct perl_memory_debug_header *const header
+		= (struct perl_memory_debug_header *)where;
 
 # ifdef PERL_TRACK_MEMPOOL
-	if (header->interpreter != aTHX) {
-	    Perl_croak_nocontext("panic: realloc from wrong pool, %p!=%p",
-				 header->interpreter, aTHX);
-	}
-	assert(header->next->prev == header);
-	assert(header->prev->next == header);
+	    if (header->interpreter != aTHX) {
+		Perl_croak_nocontext("panic: realloc from wrong pool, %p!=%p",
+				     header->interpreter, aTHX);
+	    }
+	    assert(header->next->prev == header);
+	    assert(header->prev->next == header);
 #  ifdef PERL_POISON
-	if (header->size > size) {
-	    const MEM_SIZE freed_up = header->size - size;
-	    char *start_of_freed = ((char *)where) + size;
-	    PoisonFree(start_of_freed, freed_up, char);
-	}
+	    if (header->size > size) {
+		const MEM_SIZE freed_up = header->size - size;
+		char *start_of_freed = ((char *)where) + size;
+		PoisonFree(start_of_freed, freed_up, char);
+	    }
 #  endif
 # endif
 # ifdef MDH_HAS_SIZE
-	header->size = size;
+	    header->size = size;
 # endif
-    }
+	}
 #endif
 #ifdef DEBUGGING
-    if ((SSize_t)size < 0)
-	Perl_croak_nocontext("panic: realloc, size=%"UVuf, (UV)size);
+	if ((SSize_t)size < 0)
+	    Perl_croak_nocontext("panic: realloc, size=%"UVuf, (UV)size);
 #endif
 #ifdef PERL_DEBUG_READONLY_COW
-    if ((ptr = mmap(0, size, PROT_READ|PROT_WRITE,
-		    MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) {
-	perror("mmap failed");
-	abort();
-    }
-    Copy(where,ptr,oldsize < size ? oldsize : size,char);
-    if (munmap(where, oldsize)) {
-	perror("munmap failed");
-	abort();
-    }
+	if ((ptr = mmap(0, size, PROT_READ|PROT_WRITE,
+			MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) {
+	    perror("mmap failed");
+	    abort();
+	}
+	Copy(where,ptr,oldsize < size ? oldsize : size,char);
+	if (munmap(where, oldsize)) {
+	    perror("munmap failed");
+	    abort();
+	}
 #else
-    ptr = (Malloc_t)PerlMem_realloc(where,size);
+	ptr = (Malloc_t)PerlMem_realloc(where,size);
 #endif
-    PERL_ALLOC_CHECK(ptr);
+	PERL_ALLOC_CHECK(ptr);
 
     /* MUST do this fixup first, before doing ANYTHING else, as anything else
        might allocate memory/free/move memory, and until we do the fixup, it
        may well be chasing (and writing to) free memory.  */
-    if (ptr != NULL) {
+	if (ptr != NULL) {
 #ifdef PERL_TRACK_MEMPOOL
-	struct perl_memory_debug_header *const header
-	    = (struct perl_memory_debug_header *)ptr;
+	    struct perl_memory_debug_header *const header
+		= (struct perl_memory_debug_header *)ptr;
 
 #  ifdef PERL_POISON
-	if (header->size < size) {
-	    const MEM_SIZE fresh = size - header->size;
-	    char *start_of_fresh = ((char *)ptr) + size;
-	    PoisonNew(start_of_fresh, fresh, char);
-	}
+	    if (header->size < size) {
+		const MEM_SIZE fresh = size - header->size;
+		char *start_of_fresh = ((char *)ptr) + size;
+		PoisonNew(start_of_fresh, fresh, char);
+	    }
 #  endif
 
-	maybe_protect_rw(header->next);
-	header->next->prev = header;
-	maybe_protect_ro(header->next);
-	maybe_protect_rw(header->prev);
-	header->prev->next = header;
-	maybe_protect_ro(header->prev);
+	    maybe_protect_rw(header->next);
+	    header->next->prev = header;
+	    maybe_protect_ro(header->next);
+	    maybe_protect_rw(header->prev);
+	    header->prev->next = header;
+	    maybe_protect_ro(header->prev);
 #endif
-        ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE);
-    }
+	    ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE);
+	}
 
     /* In particular, must do that fixup above before logging anything via
      *printf(), as it can reallocate memory, which can cause SEGVs.  */
 
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
+	DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
+	DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
 
-
-    if (ptr != NULL) {
-	return ptr;
-    }
-    else {
+	if (ptr == NULL) {
 #ifndef ALWAYS_NEED_THX
-	dTHX;
+	    dTHX;
 #endif
-	if (PL_nomemok)
-	    return NULL;
-	else {
-	    croak_no_mem();
+	    if (PL_nomemok)
+		ptr = NULL;
+	    else
+		croak_no_mem();
 	}
     }
-    NOT_REACHED; /*NOTREACHED*/
+    return ptr;
 }
 
 /* safe version of system's free() */
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Dec 5, 2014

From @bulk88

On Wed Dec 03 02​:06​:29 2014, bulk88 wrote​:

This is a bug report for perl from bulk88@​hotmail.com,
generated with the help of perlbug 1.40 running under perl 5.21.7.

-----------------------------------------------------------------
[Please describe your issue here]

See attached patch.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Dec 6, 2014

From @cpansprout

On Wed Dec 03 02​:06​:29 2014, bulk88 wrote​:

This is a bug report for perl from bulk88@​hotmail.com,
generated with the help of perlbug 1.40 running under perl 5.21.7.

-----------------------------------------------------------------
[Please describe your issue here]

See attached patch. Since goto isn't an option because of
http​://perl5.git.perl.org/perl.git/commit/c62df97fd6a0ef53562060054f04dfeadb67f5f8
for avoiding whitespace changes, just change the whitespace. I didn't
notice that the original patch was applied before, and I didn't notice
it was reverted later, but I *just* noticed half of the original patch
was surviving rebasing for weeks, and went to investigate if it was
applied and found out it was partially reverted. This patch finishes
off
the point of having 1 exit path to set a break point.

Thank you. Applied as b033d66.

(Did I forget to say the same for the previous patch?)

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Dec 6, 2014

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Dec 6, 2014

@cpansprout - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant