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] don't call SvPV and toss the result if no PerlIO ptr #14209

Closed
p5pRT opened this issue Nov 5, 2014 · 5 comments
Closed

[PATCH] don't call SvPV and toss the result if no PerlIO ptr #14209

p5pRT opened this issue Nov 5, 2014 · 5 comments

Comments

@p5pRT
Copy link

p5pRT commented Nov 5, 2014

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

Searchable as RT123131$

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2014

From @bulk88

Created by @bulk88

See attached patch. Unsmoked.

Perl Info

Flags:
                  category=core
                  severity=low

Site configuration information for perl 5.21.4:

Configured by Owner at Thu Sep 18 12:08:58 2014.

Summary of my perl5 (revision 5 version 21 subversion 4) configuration:
                Derived from: 7d2b2edb94ab56333b9049a3e26d15ea18445512
                Ancestor: 19be3be6968e2337bcdfe480693fff795ecd1304
                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
-DWIN32
-D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS
-DPERL_HASH_FUNC_ONE_AT_A_TIME -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T',
                  optimize='-O1 -MD -Zi -DNDEBUG',
                  cppflags='-DWIN32'
                  ccversion='12.00.8168', gccversion='', gccosandvers=''
                  intsize=4, longsize=4, ptrsize=4, doublesize=8,
byteorder=1234
                  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
-libpath:"c:\perl521\lib\CORE"  -machine:x86'
                  libpth=C:\PROGRA~1\MIAF9D~1\VC98\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  -libpath:"c:\perl521\lib\CORE"  -machine:x86'

Locally applied patches:
                  uncommitted-changes
                  a0fe7a7e75de29e59f1da0d6822dc06e5be658fe
                  a261faffee83d0145642ab5d1d046c9f813bc497
                  6506ab86ad1602a9ca720fcd30446dce1461d23d
                  7d2b2edb94ab56333b9049a3e26d15ea18445512


@INC for perl 5.21.4:
                  lib
                  C:/perl521/srcnew/lib
                  .


Environment for perl 5.21.4:
                  HOME (unset)
                  LANG (unset)
                  LANGUAGE (unset)
                  LD_LIBRARY_PATH (unset)
                  LOGDIR (unset)
                  PATH=
                  PERL_BADLANG (unset)
                  PERL_JSON_BACKEND=Cpanel::JSON::XS
                  PERL_YAML_BACKEND=YAML
                  SHELL (unset)

















@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2014

From @bulk88

0001-don-t-call-SvPV-and-toss-the-result-if-no-PerlIO-ptr.patch
From bf09951a07524194da0c49f57eb9aa5a4ac8d8a6 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Tue, 4 Nov 2014 20:33:23 -0500
Subject: [PATCH] don't call SvPV and toss the result if no PerlIO ptr

If f is NULL, SvPV and Perl_get_context are unnecessarily executed. Fix
it for efficiency. Move 2nd dTHX to the scope where it is first used
similar to commit 2bcd6579c4 .
---
 perlio.c |   25 ++++++++++++++-----------
 1 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/perlio.c b/perlio.c
index 7eac37f..5d411a2 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5100,11 +5100,13 @@ int
 PerlIO_setpos(PerlIO *f, SV *pos)
 {
     if (SvOK(pos)) {
-	STRLEN len;
-	dTHX;
-	const Off_t * const posn = (Off_t *) SvPV(pos, len);
-	if (f && len == sizeof(Off_t))
-	    return PerlIO_seek(f, *posn, SEEK_SET);
+	if (f) {
+	    dTHX;
+	    STRLEN len;
+	    const Off_t * const posn = (Off_t *) SvPV(pos, len);
+	    if(len == sizeof(Off_t))
+		return PerlIO_seek(f, *posn, SEEK_SET);
+	}
     }
     SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
@@ -5114,15 +5116,16 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 int
 PerlIO_setpos(PerlIO *f, SV *pos)
 {
-    dTHX;
     if (SvOK(pos)) {
-	STRLEN len;
-	Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len);
-	if (f && len == sizeof(Fpos_t)) {
+	if (f) {
+	    dTHX;
+	    STRLEN len;
+	    Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len);
+	    if(len == sizeof(Fpos_t))
 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
-	    return fsetpos64(f, fpos);
+		return fsetpos64(f, fpos);
 #else
-	    return fsetpos(f, fpos);
+		return fsetpos(f, fpos);
 #endif
 	}
     }
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2014

From @cpansprout

On Tue Nov 04 17​:35​:42 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.4.

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

See attached patch. Unsmoked.

Thank you. Applied as e1a83e7.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2014

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

@p5pRT p5pRT closed this as completed Nov 5, 2014
@p5pRT
Copy link
Author

p5pRT commented Nov 5, 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