Skip Menu |
Report information
Id: 131645
Status: pending release
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: randir <sergey.aleynikov [at] gmail.com>
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: medium
Type: core
Perl Version: 5.27.1
Fixed In: (no value)



From: Sergey Aleynikov <sergey.aleynikov [...] gmail.com>
Date: Sat, 24 Jun 2017 14:30:39 +0300
To: perlbug [...] perl.org
Subject: pp_sys.c:1236: OP *Perl_pp_sselect(): Assertion `SvPOK(sv)' failed.
Download (untitled) / with headers
text/plain 5.7k
This is a bug report for perl from sergey.aleynikov@gmail.com, generated with the help of perlbug 1.40 running under perl 5.27.1. ----------------------------------------------------------------- [Please describe your issue here] While fuzzing perl v5.27.1-37-g4c95ee9f29 built with afl and run under libdislocator, I found the following program select$$,$a,$a,$$ to cause an assertion failure. This is a regression between 5.14 and 5.16, bisect points to: commit 9d6d5a7950f47e97191ed3cc7a45cd5b06163193 Author: Father Chrysostomos <sprout@cpan.org> Date: Wed Nov 23 17:48:47 2011 -0800 Make sselect call fetch once Not only does this commit make four-argument select call fetch once on each argument (instead of sometimes 0 times), but it also checks whether the argument is a string after calling fetch now, instead of before, in determining whether to warn about a non-string. GDB info about the crash location is: (gdb) bt #0 __GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:51 #1 0x00007fbaff26a3fa in __GI_abort () at abort.c:89 #2 0x00007fbaff261e37 in __assert_fail_base (fmt=<optimized out>, assertion=assertion@entry=0x55d29d6f0cac "SvPOK(sv)", file=file@entry=0x55d29d6f011f "pp_sys.c", line=line@entry=1236, function=function@entry=0x55d29d6f2800 <__PRETTY_FUNCTION__.15850> "Perl_pp_sselect") at assert.c:92 #3 0x00007fbaff261ee2 in __GI___assert_fail (assertion=0x55d29d6f0cac "SvPOK(sv)", file=0x55d29d6f011f "pp_sys.c", line=1236, function=0x55d29d6f2800 <__PRETTY_FUNCTION__.15850> "Perl_pp_sselect") at assert.c:101 #4 0x000055d29d58ae71 in Perl_pp_sselect () at pp_sys.c:1236 #5 0x000055d29d447a7d in Perl_runops_debug () at dump.c:2451 #6 0x000055d29d33db3d in S_run_body (oldscope=1) at perl.c:2548 #7 0x000055d29d33d0bb in perl_run (my_perl=0x55d29de34010) at perl.c:2471 #8 0x000055d29d2f5f3e in main (argc=2, argv=0x7fffb7747a18, env=0x7fffb7747a30) at perlmain.c:123 (gdb) f 4 #4 0x000055d29d58ae71 in Perl_pp_sselect () at pp_sys.c:1236 1236 assert(SvPOK(sv)); (gdb) p sv_dump(sv) SV = PVMG(0x555555c033d0) at 0x555555c0b3a0 REFCNT = 1 FLAGS = (GMG,SMG,IOK,pIOK) IV = 2566 NV = 0 PV = 0x555555c04690 "2566"\0 CUR = 4 LEN = 10 MAGIC = 0x555555c17a30 MG_VIRTUAL = &PL_vtbl_sv MG_TYPE = PERL_MAGIC_sv(\0) MG_OBJ = 0x555555c0b388 MG_LEN = 1 MG_PTR = 0x555555c17a70 "$" $1 = void [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=medium --- Site configuration information for perl 5.27.1: Configured by root at Sun May 28 01:44:41 MSK 2017. Summary of my perl5 (revision 5 version 26 subversion 0) configuration: Derived from: 4c95ee9f298c2edfc1382d540ff89288790e78b6 Platform: osname=linux osvers=4.9.0-3-amd64 archname=x86_64-linux uname='linux dorothy 4.9.0-3-amd64 #1 smp debian 4.9.25-1 (2017-05-02) x86_64 gnulinux ' config_args='-des -Dusedevel -DDEBUGGING -Dcc=afl-clang-fast -Doptimize=-O0 -g -ggdb3 -fno-omit-frame-pointer' hint=previous useposix=true d_sigaction=define useithreads=undef usemultiplicity=undef use64bitint=define use64bitall=define uselongdouble=undef usemymalloc=n default_inc_excludes_dot=define bincompat5005=undef Compiler: cc='afl-clang-fast' ccflags ='-DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2' optimize='-O0 -g -ggdb3 -fno-omit-frame-pointer' cppflags='-DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include' ccversion='' gccversion='4.2.1 Compatible Clang 3.9.1 (tags/RELEASE_391/rc2)' gccosandvers='' intsize=4 longsize=8 ptrsize=8 doublesize=8 byteorder=12345678 doublekind=3 d_longlong=define longlongsize=8 d_longdbl=define longdblsize=16 longdblkind=3 ivtype='long' ivsize=8 nvtype='double' nvsize=8 Off_t='off_t' lseeksize=8 alignbytes=8 prototype=define Linker and Libraries: ld='afl-clang-fast' ldflags =' -fstack-protector-strong -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/llvm-3.9/bin/../lib/clang/3.9.1/lib /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/local/lib /usr/lib/llvm-3.9/bin/../lib/clang/3.9.1/lib /usr/include/x86_64-linux-gnu /usr/lib libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.24.so so=so useshrplib=false libperl=libperl.a gnulibc_version='2.24' Dynamic Linking: dlsrc=dl_dlopen.xs dlext=so d_dlsymun=undef ccdlflags='-Wl,-E' cccdlflags='-fPIC' lddlflags='-shared -O0 -g -ggdb3 -fno-omit-frame-pointer -L/usr/local/lib -fstack-protector-strong' Locally applied patches: uncommitted-changes --- @INC for perl 5.27.1: lib /usr/local/lib/perl5/site_perl/5.26.0/x86_64-linux /usr/local/lib/perl5/site_perl/5.26.0 /usr/local/lib/perl5/5.26.0/x86_64-linux /usr/local/lib/perl5/5.26.0 --- Environment for perl 5.27.1: HOME=/home/afl LANG=en_US.UTF-8 LANGUAGE=en_US:en LC_CTYPE=en_US.UTF-8 LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/afl/perlbrew/bin:/home/afl/perlbrew/perls/perl-5.24.1-dbg/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games PERLBREW_BASHRC_VERSION=0.78 PERLBREW_HOME=/home/afl/.perlbrew PERLBREW_MANPATH=/home/afl/perlbrew/perls/perl-5.24.1-dbg/man PERLBREW_PATH=/home/afl/perlbrew/bin:/home/afl/perlbrew/perls/perl-5.24.1-dbg/bin PERLBREW_PERL=perl-5.24.1-dbg PERLBREW_ROOT=/home/afl/perlbrew PERLBREW_VERSION=0.78 PERL_BADLANG (unset) SHELL=/usr/bin/zsh
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.3k
On Sat, 24 Jun 2017 04:30:48 -0700, randir wrote: Show quoted text
> This is a bug report for perl from sergey.aleynikov@gmail.com, > generated with the help of perlbug 1.40 running under perl 5.27.1. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > While fuzzing perl v5.27.1-37-g4c95ee9f29 built with afl and run > under libdislocator, I found the following program > > select$$,$a,$a,$$ > > to cause an assertion failure. This is a regression between 5.14 and > 5.16, bisect points to: > > commit 9d6d5a7950f47e97191ed3cc7a45cd5b06163193 > Author: Father Chrysostomos <sprout@cpan.org> > Date: Wed Nov 23 17:48:47 2011 -0800
I don’t understand why that commit causes the problem, but I can see what the problem is: Perl forces the first three arguments to be strings before processing the timeout argument. When it calls SvGETMAGIC on the timeout argument, it stops it from being a string (if get-magic returns a number, as is the case with $$). In this case, it is also the first argument. Perl does not expect that the arguments that were forced to strings will stop being such by the time it uses them. I have pushed a tentative patch to sprout/131645. Since system functions such as this are barely tested, could someone who actually understands this function check that it still works with my patch? -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.5k
On Sun, 25 Jun 2017 13:40:46 GMT, sprout wrote: Show quoted text
> On Sat, 24 Jun 2017 04:30:48 -0700, randir wrote:
> > This is a bug report for perl from sergey.aleynikov@gmail.com, > > generated with the help of perlbug 1.40 running under perl 5.27.1. > > > > > > ----------------------------------------------------------------- > > [Please describe your issue here] > > > > While fuzzing perl v5.27.1-37-g4c95ee9f29 built with afl and run > > under libdislocator, I found the following program > > > > select$$,$a,$a,$$ > > > > to cause an assertion failure. This is a regression between 5.14 and > > 5.16, bisect points to: > > > > commit 9d6d5a7950f47e97191ed3cc7a45cd5b06163193 > > Author: Father Chrysostomos <sprout@cpan.org> > > Date: Wed Nov 23 17:48:47 2011 -0800
> > I don’t understand why that commit causes the problem, but I can see > what the problem is: Perl forces the first three arguments to be > strings before processing the timeout argument. When it calls > SvGETMAGIC on the timeout argument, it stops it from being a string > (if get-magic returns a number, as is the case with $$). In this > case, it is also the first argument. Perl does not expect that the > arguments that were forced to strings will stop being such by the time > it uses them. > > I have pushed a tentative patch to sprout/131645. Since system > functions such as this are barely tested, could someone who actually > understands this function check that it still works with my patch?
What would constitute better testing of system functions such as 4-arg select? -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 981b
On Sun, 25 Jun 2017 07:10:34 -0700, jkeenan wrote: Show quoted text
> On Sun, 25 Jun 2017 13:40:46 GMT, sprout wrote:
> > I have pushed a tentative patch to sprout/131645. Since system > > functions such as this are barely tested, could someone who actually > > understands this function check that it still works with my patch?
> > What would constitute better testing of system functions such as 4-arg > select?
Testing the actual behaviour that the functions implement (e.g., whether select returns the right values for the right file descriptors), which, unfortunately, is very hard to do portably. (This is very easy for me to say, since most of these functions are like voodoo to me.) Most of the functions implemented in pp_sys.c are tested for basic things like whether they compile, whether they produce the right errors for read-only values, etc. These are simple, superficial tests that do basic sanity checks, without getting to the heart of the matter. -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 155b
On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote: Show quoted text
> I have pushed a tentative patch to sprout/131645.
Attached for convenience. -- Father Chrysostomos
Subject: open_24kIqGCp.txt
Download open_24kIqGCp.txt
text/plain 2.3k
commit dce93dfad366d34e6501b4b31bcbe5c446b7b61b Author: Father Chrysostomos <sprout@cpan.org> Date: Sun Jun 25 06:37:19 2017 -0700 Tentative fix for #131645 diff --git a/pp_sys.c b/pp_sys.c index 65900fa..8d93126 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1149,6 +1149,7 @@ PP(pp_sselect) struct timeval *tbuf = &timebuf; I32 growsize; char *fd_sets[4]; + SV *svs[4]; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 I32 masksize; I32 offset; @@ -1164,7 +1165,7 @@ PP(pp_sselect) SP -= 4; for (i = 1; i <= 3; i++) { - SV * const sv = SP[i]; + SV * const sv = svs[i] = SP[i]; SvGETMAGIC(sv); if (!SvOK(sv)) continue; @@ -1177,7 +1178,12 @@ PP(pp_sselect) if (!SvPOKp(sv)) Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask"); - SvPV_force_nomg_nolen(sv); /* force string conversion */ + if (SvGAMAGIC(sv)) { + svs[i] = sv_newmortal(); + sv_copypv_nomg(svs[i], sv); + } + else + SvPV_force_nomg_nolen(sv); /* force string conversion */ } j = SvCUR(sv); if (maxlen < j) @@ -1228,7 +1234,7 @@ PP(pp_sselect) tbuf = NULL; for (i = 1; i <= 3; i++) { - sv = SP[i]; + sv = svs[i]; if (!SvOK(sv) || SvCUR(sv) == 0) { fd_sets[i] = 0; continue; @@ -1275,7 +1281,7 @@ PP(pp_sselect) #endif for (i = 1; i <= 3; i++) { if (fd_sets[i]) { - sv = SP[i]; + sv = svs[i]; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 s = SvPVX(sv); for (offset = 0; offset < growsize; offset += masksize) { @@ -1284,7 +1290,8 @@ PP(pp_sselect) } Safefree(fd_sets[i]); #endif - SvSETMAGIC(sv); + if (sv != SP[i]) + SvSetMagicSV(SP[i], sv); } } diff --git a/t/op/sselect.t b/t/op/sselect.t index fedbfc7..9ec1c63 100644 --- a/t/op/sselect.t +++ b/t/op/sselect.t @@ -13,7 +13,7 @@ BEGIN { skip_all("Win32 miniperl has no socket select") if $^O eq "MSWin32" && is_miniperl(); -plan (15); +plan (16); my $blank = ""; eval {select undef, $blank, $blank, 0}; @@ -95,3 +95,12 @@ note("diff=$diff under=$under"); select (undef, undef, undef, $sleep); ::is($count, 1, 'RT120102'); } + +package _131645{ + sub TIESCALAR { bless [] } + sub FETCH { 0 } + sub STORE { } +} +tie $tie, _131645::; +select ($tie, undef, undef, $tie); +ok("no crash from select $numeric_tie, undef, undef, $numeric_tie")
CC: Perl5 Porteros <perl5-porters [...] perl.org>
From: demerphq <demerphq [...] gmail.com>
Date: Mon, 26 Jun 2017 10:48:53 +0200
Subject: Re: [perl #131645] pp_sys.c:1236: OP *Perl_pp_sselect(): Assertion `SvPOK(sv)' failed.
To: Perl RT Bug Tracker <perlbug-followup [...] perl.org>
Download (untitled) / with headers
text/plain 3.2k


On 25 Jun 2017 19:57, "Father Chrysostomos via RT" <perlbug-followup@perl.org> wrote:
Show quoted text
On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
> I have pushed a tentative patch to sprout/131645.

Attached for convenience.

Seems to me it would be easier to just assert that the args must be different if they are not undef. 4 ARG select writes to its first three arguments if they are provided, it is not sensible  to use a string bit vector as a floating point timeout value. 

Yves


Show quoted text

--

Father Chrysostomos


---
via perlbug:  queue: perl5 status: open
https://rt.perl.org/Ticket/Display.html?id=131645

commit dce93dfad366d34e6501b4b31bcbe5c446b7b61b
Author: Father Chrysostomos <sprout@cpan.org>
Date:   Sun Jun 25 06:37:19 2017 -0700

    Tentative fix for #131645

diff --git a/pp_sys.c b/pp_sys.c
index 65900fa..8d93126 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1149,6 +1149,7 @@ PP(pp_sselect)
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
+    SV *svs[4];
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
        I32 masksize;
        I32 offset;
@@ -1164,7 +1165,7 @@ PP(pp_sselect)

     SP -= 4;
     for (i = 1; i <= 3; i++) {
-       SV * const sv = SP[i];
+       SV * const sv = svs[i] = SP[i];
        SvGETMAGIC(sv);
        if (!SvOK(sv))
            continue;
@@ -1177,7 +1178,12 @@ PP(pp_sselect)
            if (!SvPOKp(sv))
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                                    "Non-string passed as bitmask");
-           SvPV_force_nomg_nolen(sv);  /* force string conversion */
+           if (SvGAMAGIC(sv)) {
+               svs[i] = sv_newmortal();
+               sv_copypv_nomg(svs[i], sv);
+           }
+           else
+               SvPV_force_nomg_nolen(sv); /* force string conversion */
        }
        j = SvCUR(sv);
        if (maxlen < j)
@@ -1228,7 +1234,7 @@ PP(pp_sselect)
        tbuf = NULL;

     for (i = 1; i <= 3; i++) {
-       sv = SP[i];
+       sv = svs[i];
        if (!SvOK(sv) || SvCUR(sv) == 0) {
            fd_sets[i] = 0;
            continue;
@@ -1275,7 +1281,7 @@ PP(pp_sselect)
 #endif
     for (i = 1; i <= 3; i++) {
        if (fd_sets[i]) {
-           sv = SP[i];
+           sv = svs[i];
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
            s = SvPVX(sv);
            for (offset = 0; offset < growsize; offset += masksize) {
@@ -1284,7 +1290,8 @@ PP(pp_sselect)
            }
            Safefree(fd_sets[i]);
 #endif
-           SvSETMAGIC(sv);
+           if (sv != SP[i])
+               SvSetMagicSV(SP[i], sv);
        }
     }

diff --git a/t/op/sselect.t b/t/op/sselect.t
index fedbfc7..9ec1c63 100644
--- a/t/op/sselect.t
+++ b/t/op/sselect.t
@@ -13,7 +13,7 @@ BEGIN {
 skip_all("Win32 miniperl has no socket select")
   if $^O eq "MSWin32" && is_miniperl();

-plan (15);
+plan (16);

 my $blank = "";
 eval {select undef, $blank, $blank, 0};
@@ -95,3 +95,12 @@ note("diff=$diff under=$under");
     select (undef, undef, undef, $sleep);
     ::is($count, 1, 'RT120102');
 }
+
+package _131645{
+    sub TIESCALAR { bless [] }
+    sub FETCH     { 0        }
+    sub STORE     {          }
+}
+tie $tie, _131645::;
+select ($tie, undef, undef, $tie);
+ok("no crash from select $numeric_tie, undef, undef, $numeric_tie")


RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.1k
On Mon, 26 Jun 2017 01:49:05 -0700, demerphq wrote: Show quoted text
> On 25 Jun 2017 19:57, "Father Chrysostomos via RT" < > perlbug-followup@perl.org> wrote: > > On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
> > I have pushed a tentative patch to sprout/131645.
> > Attached for convenience. > > > Seems to me it would be easier to just assert that the args must be > different if they are not undef. 4 ARG select writes to its first three > arguments if they are provided, it is not sensible to use a string bit > vector as a floating point timeout value.
As far as I know, we do not enforce anything like this anywhere else in perl. There are all sorts of things that may not be sensible, yet for the most part the Perl language is made up of simple building blocks that made things like ‘die return 3’ work, so you *can* write things like that if you are feeling bored. That’s what makes perl so much fun to write in. As for forbidding select$foo,"","",$foo, that to me feels a lot like forbidding substr $foo,$foo, because you might not have meant that. That sort of policing gets very annoying very quickly. -- Father Chrysostomos
Subject: Re: [perl #131645] pp_sys.c:1236: OP *Perl_pp_sselect(): Assertion `SvPOK(sv)' failed.
To: Perl RT Bug Tracker <perlbug-followup [...] perl.org>
CC: Perl5 Porteros <perl5-porters [...] perl.org>
From: demerphq <demerphq [...] gmail.com>
Date: Mon, 26 Jun 2017 18:02:05 +0200
Download (untitled) / with headers
text/plain 2.1k
On 26 June 2017 at 15:26, Father Chrysostomos via RT <perlbug-followup@perl.org> wrote: Show quoted text
> On Mon, 26 Jun 2017 01:49:05 -0700, demerphq wrote:
>> On 25 Jun 2017 19:57, "Father Chrysostomos via RT" < >> perlbug-followup@perl.org> wrote: >> >> On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
>> > I have pushed a tentative patch to sprout/131645.
>> >> Attached for convenience. >> >> >> Seems to me it would be easier to just assert that the args must be >> different if they are not undef. 4 ARG select writes to its first three >> arguments if they are provided, it is not sensible to use a string bit >> vector as a floating point timeout value.
> > As far as I know, we do not enforce anything like this anywhere else in perl. There are all sorts of things that may not be sensible, yet for the most part the Perl language is made up of simple building blocks that made things like ‘die return 3’ work, so you *can* write things like that if you are feeling bored. That’s what makes perl so much fun to write in. > > As for forbidding select$foo,"","",$foo, that to me feels a lot like forbidding substr $foo,$foo, because you might not have meant that. That sort of policing gets very annoying very quickly.
Yeah, well, I dunno. I think you are right in general, Perl shouldn't get involved in that. On the other hand, I really think select is a bit of a special beast, even though substr() superficially looks similar I don't think it particularly is. select() is special because it both /reads/ and /writes/ from its first three arguments. Also note that select is already special in that it is insisting its arguments of specific types, etc. This is because it is going to pass these things to a C routine that has very very different expectations compared to Perl. This whole bug is related to one of its arguments changing type because of differing expectations of these fields. So even though i generally agree with you I think select is a good case where the special casing it already does is fine, and where it should be enhanced with more. I guess I see it as the exception that proves the rule. :-) Yves -- perl -Mre=debug -e "/just|another|perl|hacker/"
RT-Send-CC: perl5-porters [...] perl.org
On Mon, 26 Jun 2017 09:02:23 -0700, demerphq wrote: Show quoted text
> On 26 June 2017 at 15:26, Father Chrysostomos via RT > <perlbug-followup@perl.org> wrote:
> > On Mon, 26 Jun 2017 01:49:05 -0700, demerphq wrote:
> >> On 25 Jun 2017 19:57, "Father Chrysostomos via RT" < > >> perlbug-followup@perl.org> wrote: > >> > >> On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
> >> > I have pushed a tentative patch to sprout/131645.
> >> > >> Attached for convenience. > >> > >> > >> Seems to me it would be easier to just assert that the args must be > >> different if they are not undef. 4 ARG select writes to its first > >> three > >> arguments if they are provided, it is not sensible to use a string > >> bit > >> vector as a floating point timeout value.
> > > > As far as I know, we do not enforce anything like this anywhere else > > in perl. There are all sorts of things that may not be sensible, yet > > for the most part the Perl language is made up of simple building > > blocks that made things like ‘die return 3’ work, so you *can* write > > things like that if you are feeling bored. That’s what makes perl so > > much fun to write in. > > > > As for forbidding select$foo,"","",$foo, that to me feels a lot like > > forbidding substr $foo,$foo, because you might not have meant that. > > That sort of policing gets very annoying very quickly.
> > Yeah, well, I dunno. I think you are right in general, Perl shouldn't > get involved in that. > > On the other hand, I really think select is a bit of a special beast, > even though substr() superficially looks similar I don't think it > particularly is. > > select() is special because it both /reads/ and /writes/ from its > first three arguments. > > Also note that select is already special in that it is insisting its > arguments of specific types, etc. This is because it is going to pass > these things to a C routine that has very very different expectations > compared to Perl. This whole bug is related to one of its arguments > changing type because of differing expectations of these fields. > > So even though i generally agree with you I think select is a good > case where the special casing it already does is fine, and where it > should be enhanced with more. > > I guess I see it as the exception that proves the rule. :-)
There is a practical problem with forbidding the same SV as multiple arguments to select(). For this to work consistently, we would have to croak in cases like this, too: sub foo { $h{bar} = ''; select $h{bar}, undef, undef, $_[0]; } foo($h{bar}); In code like this, perl pretends that $h{bar} and $_[0] within the sub are the same variable, even though they are different SVs. (\$_[0] will actually give a reference to $h{bar}.) select() would have to look at the defelem’s target. I think this approach would make things unnecessarily complicated, and without it forbidding such usage would make things buggy and inconsistent. BTW, my patch to make select() work while being happy to accept the same SV as multiple arguments is already written. :-) And it is simple and straightforward, too. -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 682b
On Tue, 27 Jun 2017 13:13:40 -0700, sprout wrote: Show quoted text
> BTW, my patch to make select() work while being happy to accept the > same SV as multiple arguments is already written. :-) And it is > simple and straightforward, too.
I have gone ahead and applied the patch (with slight tweaks) as e26c6904d9f9f5, since it fixes the problem in a way that is backward-compatible and does not prevent Yves’s suggestion from being implemented later. I tested it by writing a one-liner involving ties, running it through gdb, and inspecting the arguments passed to the system function. I confirmed that they were the same values as retrieved from the tied variables. -- Father Chrysostomos


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org