search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.98k stars 559 forks source link

Double reads considered evil? (deja vu) #2332

Closed p5pRT closed 20 years ago

p5pRT commented 24 years ago

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

Searchable as RT3656$

p5pRT commented 24 years ago

From @ysth

Created by @ysth

$ perl -we 'use overload q!""!\, sub {undef}; $_ = join ""\, bless []' Use of uninitialized value in join at -e line 1. Use of uninitialized value in join at -e line 1.

This problem was fixed for the SvGMAGICAL case\, but not for overload. (The problem is do_join scans through the sv's being joined to get a length to pre-grow the target sv. In the process\, it invokes the magic twice. See the archives under this subject in 1998-04 and under "Possible solution of join() double-magic?" in 1998-06.)

Are there additional cases besides overload? Seems like we need a macro SvVOLATILE or some such to properly localise the cases do_join needs to check for in sv.[ch].

Or maybe correcting this would be more expensive than just growing multiple times\, and the pre-grow check should be scrapped in favor of some form of prospective growing in the catsv loop.

Perl Info ``` Flags: category=core severity=low This perlbug was built using Perl v5.6.0 - Thu Mar 23 16:36:26 PST 2000 It is being executed now by Perl v5.6.0 - Tue Jun 20 09:44:05 PDT 2000. Site configuration information for perl v5.6.0: Configured by sthoenna at Tue Jun 20 09:44:05 PDT 2000. Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: Platform: osname=os2, osvers=2.30, archname=os2 uname='os2 efn.org 2 2.30 i386 ' config_args='-de -Dprefix=d:/perl -Aoptimize=-DDEBUGGING' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=define use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef Compiler: cc='gcc', optimize='-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s -DDEBUGGING', gccversion=2.8.1 cppflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -D_EMX_CRT_REV_=62' ccflags ='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -D_EMX_CRT_REV_=62' stdchar='char', d_stdstdio=define, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 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=y, prototype=define Linker and Libraries: ld='gcc', ldflags ='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' libpth=d:/emx/lib d:/emx/lib/mt libs=-lsocket -lm -lbsd libc=d:/emx/lib/mt/c_import.lib, so=dll, useshrplib=true, libperl=libperl.lib Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags='-Zdll', lddlflags='-Zdll -Zomf -Zmt -Zcrtdll -s' Locally applied patches: @INC for perl v5.6.0: d:/perl/lib/5.6.0/os2 d:/perl/lib/5.6.0 d:/perl/lib/site_perl/5.6.0/os2 d:/perl/lib/site_perl/5.6.0 d:/perl/lib/site_perl . Environment for perl v5.6.0: HOME=d:\home\sthoenna LANG=en_us LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=d:\bin;C:\OS2;d:\perl\bin;C:\OS2\SYSTEM;C:\OS2\INSTALL;C:\;C:\OS2\MDOS;C:\OS2\APPS;C:\MMOS2;d:\os2apps\util;d:\DOSAPPS\UTIL;c:\sio;D:\WINDOWS;d:\pdksh;d:\emx\bin;d:\emacs\19.33\bin;d:\ispell PERL_BADLANG (unset) PERL_SH_DIR=d:\BIN SHELL (unset) ```
p5pRT commented 24 years ago

From @vanstyn

In \200008080606\.e7866sL23632@​garcia\.efn\.org\, sthoenna@​efn.org writes​: :$ perl -we 'use overload q!""!\, sub {undef}; $_ = join ""\, bless []' :Use of uninitialized value in join at -e line 1. :Use of uninitialized value in join at -e line 1. : :This problem was fixed for the SvGMAGICAL case\, but not for overload. :(The problem is do_join scans through the sv's being joined to get a :length to pre-grow the target sv. In the process\, it invokes the :magic twice. See the archives under this subject in 1998-04 and :under "Possible solution of join() double-magic?" in 1998-06.) : :Are there additional cases besides overload? Seems like we need :a macro SvVOLATILE or some such to properly localise the cases do_join :needs to check for in sv.[ch]. : :Or maybe correcting this would be more expensive than just growing :multiple times\, and the pre-grow check should be scrapped in favor :of some form of prospective growing in the catsv loop.

Scrapping the pre-check was the solution I proposed way back when; that was deemed unacceptable. I feel there ought to be a way to effect a more generic solution\, so that any argument's magic is fetched only once per op​: this should allow us to simplify the code throughout\, and use more consistent mechanisms. I can't see how to do it however\, particularly given the possibility of (eg) C\<join '\,'\, $tiedrand\, $tiedrand>.

Hugo

p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

sthoenna@​efn.org wrote

Or maybe correcting this would be more expensive than just growing multiple times\, and the pre-grow check should be scrapped in favor of some form of prospective growing in the catsv loop.

That optimisation is very important - see Ilya's remarks in the threads you quoted. And correcting it is zero cost\, since the two flags can be tested in one go.

So here's the patch\, for bleadperl. I noticed that the original fix didn't have any associated tests\, so I added some.

Mike Guy

Inline Patch ```diff --- ./t/pragma/overload.t.orig Tue Aug 1 03:32:14 2000 +++ ./t/pragma/overload.t Tue Aug 8 14:49:07 2000 @@ -919,14 +919,21 @@ my $aaa; { my $bbbb = 0; $aaa = bless \$bbbb, B } -test !$aaa, 1; +test !$aaa, 1; # 207 unless ($aaa) { - test 'ok', 'ok'; + test 'ok', 'ok'; # 208 } else { - test 'is not', 'ok'; + test 'is not', 'ok'; # 208 } +# check that overload isn't done twice by join +{ my $c = 0; + package Join; + use overload '""' => sub { $c++ }; + my $x = join '', bless([]), 'pq', bless([]); + main::test $x, '0pq1'; # 209 +}; # Last test is: -sub last {208} +sub last {209} --- ./doop.c.orig Wed Aug 2 14:38:34 2000 +++ ./doop.c Tue Aug 8 15:35:14 2000 @@ -487,7 +487,7 @@ (void)SvUPGRADE(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { - if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) { + if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { SvPV(*mark, tmplen); len += tmplen; } --- ./t/op/join.t.orig Tue Aug 1 03:32:13 2000 +++ ./t/op/join.t Tue Aug 8 15:29:47 2000 @@ -1,6 +1,6 @@ #!./perl -print "1..6\n"; +print "1..10\n"; @x = (1, 2, 3); if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} @@ -20,3 +20,27 @@ $f = 'a'; $f = join $f, 'b', 'e', 'k'; if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";} + +# 7,8 check for multiple read of tied objects +{ package X; + sub TIESCALAR { my $x = 7; bless \$x }; + sub FETCH { my $y = shift; $$y += 5 }; + tie my $t, 'X'; + my $r = join ':', $t, 99, $t, 99; + print "# expected '12:99:17:99' got '$r'\nnot " if $r ne '12:99:17:99'; + print "ok 7\n"; + $r = join '', $t, 99, $t, 99; + print "# expected '22992799' got '$r'\nnot " if $r ne '22992799'; + print "ok 8\n"; +}; + +# 9,10 and for multiple read of undef +{ my $s = 5; + local ($^W, $SIG{__WARN__}) = ( 1, sub { $s+=4 } ); + my $r = join ':', 'a', undef, $s, 'b', undef, $s, 'c'; + print "# expected 'a::9:b::13:c' got '$r'\nnot " if $r ne 'a::9:b::13:c'; + print "ok 9\n"; + my $r = join '', 'a', undef, $s, 'b', undef, $s, 'c'; + print "# expected 'a17b21c' got '$r'\nnot " if $r ne 'a17b21c'; + print "ok 10\n"; +}; --- ./sv.h.orig Thu Aug 3 14:40:02 2000 +++ ./sv.h Tue Aug 8 13:21:42 2000 @@ -612,6 +612,8 @@ #define SvAMAGIC_on(sv) (SvFLAGS(sv) |= SVf_AMAGIC) #define SvAMAGIC_off(sv) (SvFLAGS(sv) &= ~SVf_AMAGIC) +#define SvGAMAGIC(sv) (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC)) + /* #define Gv_AMG(stash) \ (HV_AMAGICmb(stash) && \ End of patch ```
p5pRT commented 24 years ago

From @jhi

On Tue\, Aug 08\, 2000 at 03​:51​:27PM +0100\, Mike Guy wrote​:

sthoenna@​efn.org wrote

Or maybe correcting this would be more expensive than just growing multiple times\, and the pre-grow check should be scrapped in favor of some form of prospective growing in the catsv loop.

That optimisation is very important - see Ilya's remarks in the threads you quoted. And correcting it is zero cost\, since the two flags can be tested in one go.

So here's the patch\, for bleadperl. I noticed that the original fix didn't have any associated tests\, so I added some.

Thanks\, applied.