[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[perl #59280] PUSH on tied array gives incorrect context to method and can result in needless calls to FETCHSIZE

From: "lukeross@gmail.com (via RT)" <perlbug-followup@perl.org>
Reply-To: perl5-porters@perl.org
To: bugs-bitbucket@netlabs.develooper.com
Date: Wed, 24 Sep 2008 12:10:17 -0700
Message-ID: <rt-3.6.HEAD-29759-1222283417-35.59280-75-0@perl.org>
# New Ticket Created by  lukeross@gmail.com 
# Please include the string:  [perl #59280]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=59280 >



This is a bug report for perl from lukeross@gmail.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.


-----------------------------------------------------------------
When using tied arrays the PUSH method is always called in scalar
context, but the return value is discarded. Perl will then call
FETCHSIZE to get the array size to return from push(),
regardless of whether the caller is actually going to use the
return value.

This is inefficient where push() is called in a void context, as
the FETCHSIZE could be quite costly for some tied arrays.
Furthermore this data could well be available within the PUSH
routine and could be returned directly.

The patch below attempts to implement this, falling back to
FETCHSIZE where push() is called in a non-void context and
the PUSH routine returns no defined value. The patch hasn't
been heavily tested.
-----------------------------------------------------------------
--- perl-5.10.0/pp.c.orig	2008-09-24 18:52:07.000000000 +0100
+++ perl-5.10.0/pp.c	2008-09-24 20:01:06.000000000 +0100
@@ -4435,15 +4435,21 @@
     const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
 
     if (mg) {
+	SV *retval = 0;
 	*MARK-- = SvTIED_obj((SV*)ary, mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
-	call_method("PUSH",G_SCALAR|G_DISCARD);
+	if (call_method("PUSH", GIMME_V))
+	    retval = newSVsv(*PL_stack_sp--);
 	LEAVE;
 	SPAGAIN;
 	SP = ORIGMARK;
-	PUSHi( AvFILL(ary) + 1 );
+	if (retval && SvOK(retval)) {
+	    PUSHs(retval);
+	} else if (GIMME_V != G_VOID) {
+	    PUSHi( AvFILL(ary) + 1 );
+	}
     }
     else {
 	PL_delaymagic = DM_DELAY;
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
---
This perlbug was built using Perl 5.10.0 in the Fedora build system.
It is being executed now by Perl 5.10.0 - Thu Aug  7 05:11:31 EDT 2008.

Site configuration information for perl 5.10.0:

Configured by Red Hat, Inc. at Thu Aug  7 05:11:31 EDT 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.18-92.1.6.el5, archname=x86_64-linux-thread-multi
    uname='linux x86-3 2.6.18-92.1.6.el5 #1 smp fri jun 20 02:36:06 edt 2008 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV -Dversion=5.10.0 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dinstallprefix=/usr -Dprefix=/usr -Dprivlib=/usr/lib/perl5/5.10.0 -Dsitelib=/usr/local/lib/perl5/site_perl/5.10.0 -Dvendorlib=/usr/lib/perl5/vendor_perl/5.10.0 -Darchlib=/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi -Dsitearch=/usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi -Dvendorarch=/usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi -Darchname=x86_64-linux-thread-multi -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64 -Dotherlibdirs=/usr/local/lib/perl5/site_perl:/usr/lib/perl5/site_perl -Dvendorprefix=/usr -Dsiteprefix=/usr/local -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -D
 useperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto -Dscriptdir=/usr/bin'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='4.3.0 20080428 (Red Hat 4.3.0-8)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =''
    libpth=/usr/local/lib64 /lib64 /usr/lib64
    libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.8'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV'

Locally applied patches:
    

---
@INC for perl 5.10.0:
    /usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.10.0
    /usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    /usr/local/lib/perl5/site_perl/5.10.0
    /usr/local/lib/perl5/site_perl
    /usr/lib/perl5/site_perl
    .

---
Environment for perl 5.10.0:
    HOME=/home/lukeross
    LANG=en_GB.utf8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/lib64/qt-3.3/bin:/usr/kerberos/bin:/usr/lib64/ccache:/usr/local/bin:/usr/bin:/bin:/home/lukeross/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash
Follow-Ups from:: "Eric Brine" <ikegami@adaelis.com>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]