[perl #17376] Bug Report - our(%)
per...@perl.org
# Please include the string: [perl #17376]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17376 >
#!/usr/bin/perl
#
# Example of our(%) performance bug
#
# Mike Bird - m...@yosemite.net
#
# Discovered in perl-5.6.1-34.99.6 which is current for RedHat
#
# Programs running ridiculously slow after cleaning them up and
# adding 'use warnings' and 'use strict'. I had a bunch of
# "our (%a, %b, %c);" declarations. Here is a simple demonstration.
# Problem does not affect scalars. Haven't checked whether it
# affects arrays, or whether it affects local's or my's.
use warnings;
use strict;
$| = 1;
my $iterations = 2000; # Chosen to make performance hit readily apparent
{
our %a;
for (my $i = 0; $i <= $iterations; ++$i) {
$a{$i} = $i;
}
}
{
print "This should be fast ...";
for (my $i = 0; $i <= $iterations; ++$i) {
our %a;
die("Shouldn't happen") unless exists($a{$i});
}
print " done\n";
}
{
print "This should be slow ...";
for (my $i = 0; $i <= $iterations; ++$i) {
our (%a);
die("Shouldn't happen") unless exists($a{$i});
}
print " done\n";
}
# Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
# Platform:
# osname=linux, osvers=2.4.17-0.13smp, archname=i386-linux
# uname='linux daffy.perf.redhat.com 2.4.17-0.13smp #1 smp fri feb 1 10:30:48 est 2002 i686 unknown '
# config_args='-des -Doptimize=-O2 -march=i386 -mcpu=i686 -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dcccdlflags=-fPIC -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Uusethreads -Uuseithreads -Uuselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm'
# hint=recommended, useposix=true, d_sigaction=define
# usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
# useperlio=undef d_sfio=undef uselargefiles=undef usesocks=undef
# use64bitint=undef use64bitall=undef uselongdouble=undef
# Compiler:
# cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include',
# optimize='-O2 -march=i386 -mcpu=i686',
# cppflags='-fno-strict-aliasing -I/usr/local/include'
# ccversion='', gccversion='2.96 20000731 (Red Hat Linux 7.2 2.96-109)', gccosandvers=''
# intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
# d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
# ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
# alignbytes=4, usemymalloc=n, prototype=define
# Linker and Libraries:
# ld='gcc', ldflags =' -L/usr/local/lib'
# libpth=/usr/local/lib /lib /usr/lib
# libs=-lnsl -ldl -lm -lc -lcrypt -lutil
# perllibs=-lnsl -ldl -lm -lc -lcrypt -lutil
# libc=/lib/libc-2.2.5.so, so=so, useshrplib=false, libperl=libperl.a
# Dynamic Linking:
# dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
# cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
#
#
# Characteristics of this binary (from libperl):
# Compile-time options:
# Built under linux
# Compiled at Apr 1 2002 12:23:22
# @INC:
# /usr/lib/perl5/5.6.1/i386-linux
# /usr/lib/perl5/5.6.1
# /usr/lib/perl5/site_perl/5.6.1/i386-linux
# /usr/lib/perl5/site_perl/5.6.1
# /usr/lib/perl5/site_perl/5.6.0/i386-linux
# /usr/lib/perl5/site_perl/5.6.0
# /usr/lib/perl5/site_perl
# /usr/lib/perl5/vendor_perl/5.6.1/i386-linux
# /usr/lib/perl5/vendor_perl/5.6.1
# /usr/lib/perl5/vendor_perl
# .
Yitzchak Scott-Thoennes
># adding 'use warnings' and 'use strict'. I had a bunch of
># "our (%a, %b, %c);" declarations. Here is a simple demonstration.
># Problem does not affect scalars. Haven't checked whether it
># affects arrays, or whether it affects local's or my's.
Good job tracking this down. our(%foo) can indeed be bad news.
~/pbed $perl -MO=Concise -we'our %x'
5 <@> leave[%x:1,2] vKP/REFC ->(end)
1 <0> enter ->2
2 <;> nextstate(main 1 -e:1) v ->3
4 <1> rv2hv[t2] vK/OURINTR,1 ->5
3 <$> gv(*x) s ->4
-e syntax OK
~/pbed $perl -MO=Concise -we'our (%x)'
5 <@> leave[%x:1,2] vKP/REFC ->(end)
1 <0> enter ->2
2 <;> nextstate(main 1 -e:1) v ->3
4 <1> rv2hv[t2] lKP/OURINTR,1 ->5
3 <$> gv(*x) s ->4
-e syntax OK
Here we see the () version doing rv2hv in list context. That loads
the whole hash onto the stack for no apparent purpose. Even if there
is need for the rv2hv op being left there at all (for B::xxx ??)
it should have void context.
Here are some tests to monitor the effect of a bare our declaration
with the tie interface. "our @x", "our (@x)" and "our (%x)" all fail
(TODO'd) though only "our (%x)" has a significant perfomance impact.
--- /dev/null Mon Sep 23 11:45:36 2002
+++ perl/t/comp/our.t Mon Sep 23 10:55:48 2002
@@ -0,0 +1,49 @@
+#!./perl
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+print "1..6\n";
+
+{
+ package TieAll;
+ # tie, track, and report what calls are made
+ my @calls;
+ sub AUTOLOAD {
+ for ($AUTOLOAD =~ /TieAll::(.*)/) {
+ if (/TIE/) { return bless {} }
+ elsif (/calls/) { return join ',', splice @calls }
+ else {
+ push @calls, $_;
+ # FETCHSIZE doesn't like undef
+ # if FIRSTKEY, see if NEXTKEY is also called
+ return 1 if /FETCHSIZE|FIRSTKEY/;
+ return;
+ }
+ }
+ }
+}
+
+tie $x, 'TieAll';
+tie @x, 'TieAll';
+tie %x, 'TieAll';
+
+{our $x;}
+is(TieAll->calls, '', 'our $x has no runtime effect');
+{our ($x);}
+is(TieAll->calls, '', 'our ($x) has no runtime effect');
+{our %x;}
+is(TieAll->calls, '', 'our %x has no runtime effect');
+
+{
+ local $TODO = 'perl #17376';
+ {our (%x);}
+ is(TieAll->calls, '', 'our (%x) has no runtime effect');
+ {our @x;}
+ is(TieAll->calls, '', 'our @x has no runtime effect');
+ {our (@x);}
+ is(TieAll->calls, '', 'our (@x) has no runtime effect');
+}
--- perl/MANIFEST.orig Wed Sep 11 12:34:16 2002
+++ perl/MANIFEST Mon Sep 23 11:47:16 2002
@@ -2346,6 +2346,7 @@
t/comp/decl.t See if declarations work
t/comp/hints.t See if %^H works
t/comp/multiline.t See if multiline strings work
+t/comp/our.t Tests for our declaration
t/comp/package.t See if packages work
t/comp/proto.t See if function prototypes work
t/comp/redef.t See if we get correct warnings on redefined subs
End of Patch.
h...@crypt.org
:Here are some tests to monitor the effect of a bare our declaration
:with the tie interface. "our @x", "our (@x)" and "our (%x)" all fail
:(TODO'd) though only "our (%x)" has a significant perfomance impact.
Thanks, applied as #17921.
Hugo
Yitzchak Scott-Thoennes
>On Tue, 24 Sep 2002 01:58:00 +0100, h...@crypt.org wrote:
>>Yes; I suspect the list context is propagated too early, and the void
>>context fails to make it through to an already list()'d op.
>>
>>Are you planning to look into fixing this?
>
>I looked into fixing it, but op.c is somewhat too undercommented
>for me to make out what needs to be done.
Looks like list context is propagated too early in *two* places.
Commenting out both fixes the problem, but it seems like it could have
negative effects. Surely those list() calls are there for a reason?
More advice appreciated.
--- op.c.orig Mon Sep 30 13:13:28 2002
+++ op.c Mon Sep 30 14:46:20 2002
@@ -2146,10 +2146,10 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
OP *rops = Nullop;
int maybe_scalar = 0;
- if (o->op_flags & OPf_PARENS)
+/* if (o->op_flags & OPf_PARENS)
list(o);
else
- maybe_scalar = 1;
+*/ maybe_scalar = 1;
if (attrs)
SAVEFREEOP(attrs);
o = my_kid(o, attrs, &rops);
@@ -2381,7 +2381,7 @@ OP *
Perl_localize(pTHX_ OP *o, I32 lex)
{
if (o->op_flags & OPf_PARENS)
- list(o);
+/* list(o)*/;
else {
if (ckWARN(WARN_PARENTHESIS)
&& PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
End of Patch.
h...@crypt.org
:>I looked into fixing it, but op.c is somewhat too undercommented
:>for me to make out what needs to be done.
Well yes, that's one of the problems. :)
:Looks like list context is propagated too early in *two* places.
:Commenting out both fixes the problem, but it seems like it could have
:negative effects. Surely those list() calls are there for a reason?
:More advice appreciated.
It doesn't break any tests, which is an interesting signal. I've applied
a slightly more verbose form of this patch (as below) for now, as #17949;
this does at least fix the performance bug originally reported, but let's
keep an eye out for anything else it might affect.
Hugo
==== //depot/perl/op.c#517 - /src/hv/perl/op.c ====
@@ -2146,10 +2146,16 @@
OP *rops = Nullop;
int maybe_scalar = 0;
+/* [perl #17376]: this appears to be premature, and results in code such as
+ C< my(%x); > executing in list mode rather than void mode */
+#if 0
if (o->op_flags & OPf_PARENS)
list(o);
else
maybe_scalar = 1;
+#else
+ maybe_scalar = 1;
+#endif
if (attrs)
SAVEFREEOP(attrs);
o = my_kid(o, attrs, &rops);
@@ -2381,7 +2387,13 @@
Perl_localize(pTHX_ OP *o, I32 lex)
{
if (o->op_flags & OPf_PARENS)
+/* [perl #17376]: this appears to be premature, and results in code such as
+ C< our(%x); > executing in list mode rather than void mode */
+#if 0
list(o);
+#else
+ ;
+#endif
h...@crypt.org
::Looks like list context is propagated too early in *two* places.
::Commenting out both fixes the problem, but it seems like it could have
::negative effects. Surely those list() calls are there for a reason?
::More advice appreciated.
:
:It doesn't break any tests, which is an interesting signal.
Additionally, I notice that with this patch the C< our(%x) > TODO test
passes, but the C< our @x > and C< our(@x) > tests still fail.
Hugo
Yitzchak Scott-Thoennes
Patch below should fix that. rv2hv would need similar treatment if
it's scalar code did anything that invoked a tie method. That leads
me to notice the following bug which I will try to deal with later:
~ $perl -MTie::Hash -wle'tie %x,"Tie::StdHash"; %x=1..2; print(%x?"ok":"not ok")'
not ok
Alternatively, rv2?v in void context should be optimized away (in
scalarvoid()?). I took a stab at doing this but couldn't get it quite
right.
--- perl/pp_hot.c.orig Thu Aug 22 16:01:00 2002
+++ perl/pp_hot.c Mon Sep 30 18:08:22 2002
@@ -780,7 +780,7 @@ PP(pp_rv2av)
}
SP += maxarg;
}
- else {
+ else if (GIMME_V == G_SCALAR) {
dTARGET;
I32 maxarg = AvFILL(av) + 1;
SETi(maxarg);
--- perl/t/comp/our.t.orig Mon Sep 30 18:25:44 2002
+++ perl/t/comp/our.t Mon Sep 30 18:26:46 2002
@@ -33,17 +33,18 @@
{our $x;}
is(TieAll->calls, '', 'our $x has no runtime effect');
+
{our ($x);}
is(TieAll->calls, '', 'our ($x) has no runtime effect');
+
{our %x;}
is(TieAll->calls, '', 'our %x has no runtime effect');
-{
- local $TODO = 'perl #17376';
- {our (%x);}
- is(TieAll->calls, '', 'our (%x) has no runtime effect');
- {our @x;}
- is(TieAll->calls, '', 'our @x has no runtime effect');
- {our (@x);}
- is(TieAll->calls, '', 'our (@x) has no runtime effect');
-}
+{our (%x);}
+is(TieAll->calls, '', 'our (%x) has no runtime effect');
+
+{our @x;}
+is(TieAll->calls, '', 'our @x has no runtime effect');
+
+{our (@x);}
+is(TieAll->calls, '', 'our (@x) has no runtime effect');
--- perl/op.c.orig Tue Oct 1 09:46:44 2002
+++ perl/op.c Tue Oct 1 09:52:02 2002
@@ -2147,7 +2147,7 @@
int maybe_scalar = 0;
/* [perl #17376]: this appears to be premature, and results in code such as
- C< my(%x); > executing in list mode rather than void mode */
+ C< our(%x); > executing in list mode rather than void mode */
#if 0
if (o->op_flags & OPf_PARENS)
list(o);
End of Patch.
h...@crypt.org
:On Tue, 01 Oct 2002 11:09:24 +0100, h...@crypt.org wrote:
:>Additionally, I notice that with this patch the C< our(%x) > TODO test
:>passes, but the C< our @x > and C< our(@x) > tests still fail.
:
:Patch below should fix that.
Thanks, applied as #17963.
Hugo