On Wed Nov 11 02:42:31 2009, tjc wrote: > Hi, > could you please re-test this bug on the current version of Perl, 5.10.1, > and report back if the behaviour has been fixed. > > Thanks.
Using Perl 5.17.6, this is still a problem, I guess, I didn't run 5.6 to see what happens. Anyways " open(STDOUT,'>',$fn) or die "cannot open parent : $!";" makes a call to CRT's dup2, fh 3 is the handle to fork_test.txt. fh 1 is stdout. The line that calls PerlLIODup2 is http://perl5.git.perl.org/perl.git/blob/93a641ae382638ffd1:/doio.c#l617 ____________________________________________________________ msvcr71.dll!_dup2(int fh1=3, int fh2=1) Line 57 C perl517.dll!PerlLIODup2(IPerlLIO * piPerl=0x00344364, int handle1=3, int handle2=1) Line 959 + 0xd C > perl517.dll!Perl_do_openn(interpreter * my_perl=0x00345ecc, gv * gv=0x008fd034, const char * oname=0x00b41414, long len=1, int as_raw=0, int rawmode=0, int rawperm=0, _PerlIO * * supplied_fp=0x00000000, sv * * svp=0x00a7b020, long num_svs=1) Line 617 + 0x1e C perl517.dll!Perl_pp_open(interpreter * my_perl=0x00345ecc) Line 638 + 0x2e C perl517.dll!Perl_runops_standard(interpreter * my_perl=0x00345ecc) Line 42 + 0xa C perl517.dll!S_run_body(interpreter * my_perl=0x00345ecc, long oldscope=1) Line 2430 + 0xd C perl517.dll!perl_run(interpreter * my_perl=0x00345ecc) Line 2349 C perl517.dll!RunPerl(int argc=2, char * * argv=0x00342478, char * * env=0x003451f0) Line 270 + 0x9 C perl.exe!mainCRTStartup() Line 398 + 0xe C kernel32.dll!_BaseProcessStart@4() + 0x23 ___________________________________________________________________ Then CRT dup2 winds up calling " SetStdHandle( STD_OUTPUT_HANDLE, (HANDLE)value );", which is per Win32 process, with callstack, ______________________________________________________________________ > kernel32.dll!_SetStdHandle@8() msvcr71.dll!_dup2(int fh1=3, int fh2=1) Line 98 + 0x7 C perl517.dll!win32_dup2(int fd1=3, int fd2=1) Line 3293 + 0xe C perl517.dll!PerlLIODup2(IPerlLIO * piPerl=0x00344364, int handle1=3, int handle2=1) Line 959 + 0xd C perl517.dll!Perl_do_openn(interpreter * my_perl=0x00345ecc, gv * gv=0x008fd034, const char * oname=0x00becc34, long len=1, int as_raw=0, int rawmode=0, int rawperm=0, _PerlIO * * supplied_fp=0x00000000, sv * * svp=0x00a7aff8, long num_svs=1) Line 617 + 0x1e C perl517.dll!Perl_pp_open(interpreter * my_perl=0x00345ecc) Line 638 + 0x2e C perl517.dll!Perl_runops_standard(interpreter * my_perl=0x00345ecc) Line 42 + 0xa C perl517.dll!S_run_body(interpreter * my_perl=0x00345ecc, long oldscope=1) Line 2430 + 0xd C perl517.dll!perl_run(interpreter * my_perl=0x00345ecc) Line 2349 C perl517.dll!RunPerl(int argc=2, char * * argv=0x00342478, char * * env=0x003451f0) Line 270 + 0x9 C perl.exe!mainCRTStartup() Line 398 + 0xe C kernel32.dll!_BaseProcessStart@4() + 0x23 ______________________________________________________________________ The test script I am using is ___________________________________________________________________ #!/usr/bin/perl -w use Data::Dumper; use warnings; use strict; use Win32API::File 'FdGetOsFHandle'; `del fork_test.txt`; my $fn = 'fork_test.txt'; my $pid; warn "b4 fork STDOUT ".sprintf("%x", FdGetOsFHandle(fileno(STDOUT)))."\n"; if ($pid = fork) { print "Hello from ithread 1\n"; #sleep 1; warn "p b4 STDOUT ".sprintf("%x", FdGetOsFHandle(fileno(STDOUT)))."\n"; sleep 5; open(STDOUT,'>',$fn) or die "cannot open parent : $!"; warn "p aftr STDOUT ".sprintf("%x", FdGetOsFHandle(fileno(STDOUT)))."\n"; system('ipconfig'); close STDOUT; waitpid($pid,0); } else { die 'Couldn\'t fork!' unless defined $pid; #sleep 2; warn "c1 STDOUT ".sprintf("%x", FdGetOsFHandle(fileno(STDOUT)))."\n"; warn "c1 READ ".sprintf("%x", FdGetOsFHandle(fileno(READ)))."\n"; open(READ,'<',$fn) or die "cannot open parent : $!"; warn "c2 READ ".sprintf("%x", FdGetOsFHandle(fileno(READ)))."\n"; print "Hello from ithread 2\n"; my $l; do { undef $l; my $i = 0; while(!defined($l)) { my $slp = int(($i++ + 9) / 10); sleep($slp); $l = <READ>; }; print $l; } until($l =~ /Gateway/); close READ; sleep 10000; } ____________________________________________________________ How to fix this, I guess all fileno calls need to be hooked, with a per perl interp set of Perl level FDs that are then converted to CRT level FDs. On a clone/fork, all the FDs of the parent interp are duped to new CRT level FDs, but the Perl level FDs stay the same. Not sure where and how the hooking should happen. No idea if this will work, but its beyond my skill set. Comments? I wonder if this bug can be done with ithreads. -- bulk88 ~ bulk88 at hotmail.com --- via perlbug: queue: perl5 status: open https://rt.perl.org:443/rt3/Ticket/Display.html?id=22948
