Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

smoke-me/leont/perlio-win32 branch #13968

Closed
p5pRT opened this issue Jul 4, 2014 · 45 comments
Closed

smoke-me/leont/perlio-win32 branch #13968

p5pRT opened this issue Jul 4, 2014 · 45 comments

Comments

@p5pRT
Copy link

p5pRT commented Jul 4, 2014

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

Searchable as RT122224$

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

Created by @bulk88

After some offline discussion with leont, he created
http​://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-me/leont/perlio-win32
. The change

-------------------------------------------------------------
--- a/win32/win32io.c
+++ b/win32/win32io.c
@​@​ -323,7 +323,7 @​@​ PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o,
CLONE_PARAMS *params, int flags)
  PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
  HANDLE proc = GetCurrentProcess();
  HANDLE new_h;
- if (DuplicateHandle(proc, os->h, proc, &new_h, 0, FALSE,
DUPLICATE_SAME_ACCESS))
+ if (DuplicateHandle(proc, os->h, proc, &new_h, 0, TRUE,
DUPLICATE_SAME_ACCESS))
  {
  char mode[8];
  int fd = win32_open_osfhandle((intptr_t) new_h,
PerlIOUnix_oflags(PerlIO_modestr(o,mode)));

-------------------------------------------------------------

reflects correcting PerlIOWin32_dup to MS CRT's implementation of dup.
Obviously we want the handle to exist in a child process
(system/backticks/open).

But this branch SEGVs. Callstack

-------------------------------------------------------------

  perl521.dll!PerlIOWin32_dup(interpreter * my_perl=0x00364dbc, _PerlIO * * f=0x008f62cc, _PerlIO * * o=0x008f677c, clone_params * params=0x00000000, int flags=2) Line 326 + 0xb C
  perl521.dll!PerlIOBase_dup(interpreter * my_perl=0x00364dbc, _PerlIO * * f=0x008f62cc, _PerlIO * * o=0x008f627c, clone_params * param=0x00000000, int flags=2) Line 2207 C
  perl521.dll!PerlIO_fdupopen(interpreter * my_perl=0x0012fbb0, _PerlIO * * f=0x00070023, clone_params * param=0x00000000, int flags=2) Line 506 + 0x13 C
  perl521.dll!Perl_do_open6(interpreter * my_perl=0x00364dbc, gv * gv=0x00e6de6c, const char * oname=0x00ebc87c, unsigned int len=3, _PerlIO * * supplied_fp=0x00000000, sv * * svp=0x00f9d4f4, unsigned long num_svs=0) Line 443 + 0x10 C
  perl521.dll!Perl_pp_open(interpreter * my_perl=0x00364dbc) Line 638 C
  perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00364dbc) Line 41 + 0x4 C
  perl521.dll!S_run_body(interpreter * my_perl=0x008f62cc, long oldscope=1) Line 2408 + 0xa C
  perl521.dll!perl_run(interpreter * my_perl=0x00364dbc) Line 2331 + 0x8 C
  perl521.dll!RunPerl(int argc=3, char * * argv=0x01364d58, char * * env=0x00363380) Line 258 + 0x6 C
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23
-----------------------------------------------

at

-----------------------------------------------
PerlIO *
PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
{
PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
HANDLE proc = GetCurrentProcess();
HANDLE new_h;
if (DuplicateHandle(proc, os->h, proc, &new_h, 0, TRUE, DUPLICATE_SAME_ACCESS)) <<<<<<<<<<<<<<<<<<<<<
  {
  char mode[8];
  int fd = win32_open_osfhandle((intptr_t) new_h, PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
------------------------------------------------

because var os of type PerlIOWin32 * is null.

dumping vars f and o shows f is a ptr to NULL, o is a ptr to something
valid.

-----------------------------------------------------
- f 0x008f6cb4 _PerlIO * *
+ 0x00000000 {next=??? tab=??? flags=??? ...} _PerlIO *
- o 0x00365cfc _PerlIO * *
+ 0x008f709c {next=0x00000000 {next=??? tab=??? flags=??? ...}
tab=0x282bd478 _PerlIO_win32 flags=2114560 ...} _PerlIO *
-----------------------------------------------------

crash line in PP is

http​://perl5.git.perl.org/perl.git/blob/smoke-me/leont/perlio-win32​:/dist/IO/lib/IO/Handle.pm#l379

----------------------------------------------------
sub fdopen {
  @​_ == 3 or croak 'usage​: $io->fdopen(FD, MODE)';
  my ($io, $fd, $mode) = @​_;
  local(*GLOB);

  if (ref($fd) && "".$fd =~ /GLOB\(/o) {
  # It's a glob reference; Alias it as we cannot get name of anon GLOBs
  my $n = qualify(*GLOB);
  *GLOB = *{*$fd};
  $fd = $n;
  } elsif ($fd =~ m#^\d+$#) {
  # It's an FD number; prefix with "=".
  $fd = "=$fd";
  }

  open($io, _open_mode_string($mode) . '&' . $fd)<<<<<<<<<<<<<<<<<<<<
  ? $io : undef;
}
-----------------------------------------------------------

The process that crashed was "..\perl.exe -I..\lib harness".

I dont have any background in perlio on PP or C level. What are vars
PerlIO *f, PerlIO *o in Dup? what does "f" and "o" mean?
http​://perldoc.perl.org/perliol.html explains nothing.

----------------------------------------------------------
PerlIO *
PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
{
  const PerlIOUnix * const os = PerlIOSelf(o, PerlIOUnix);
  int fd = os->fd;
  if (flags & PERLIO_DUP_FD) {
  fd = PerlLIO_dup(fd);
  }
  if (fd >= 0) {
  f = PerlIOBase_dup(aTHX_ f, o, param, flags);
  if (f) {
--------------------------------------------------------
PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
{
PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
HANDLE proc = GetCurrentProcess();
HANDLE new_h;
if (DuplicateHandle(proc, os->h, proc, &new_h, 0, TRUE,
DUPLICATE_SAME_ACCESS))
  {
  char mode[8];
  int fd = win32_open_osfhandle((intptr_t) new_h,
PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
--------------------------------------------------------
Unix_dup uses var o first. Win32_dup uses var f first. Should Win32_dup
be using var o first? its not a ptr to NULL unlike var f. IDK.

Perl Info

Flags:
        category=core
        severity=low

Site configuration information for perl 5.21.1:

Configured by Owner at Wed May 28 03:57:28 2014.

Summary of my perl5 (revision 5 version 21 subversion 1) configuration:
      Local Commit: 1abbcfa06576bf8a6937c566bb4d18ba803b59d8
      Ancestor: 234105dd8a732de5fb48ccb1838c99281f89f669
      Platform:
        osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
        uname=''
        config_args='undef'
        hint=recommended, useposix=true, d_sigaction=undef
        useithreads=define, usemultiplicity=define
        use64bitint=undef, use64bitall=undef, uselongdouble=undef
        usemymalloc=n, bincompat5005=undef
      Compiler:
        cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -G7 -GL
-DWIN32 -D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS
-DPERL_HASH_FUNC_ONE_AT_A_TIME -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T',
        optimize='-O1 -MD -Zi -DNDEBUG -G7 -GL',
        cppflags='-DWIN32'
        ccversion='13.10.6030', gccversion='', gccosandvers=''
        intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
        d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8
        ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64',
lseeksize=8
        alignbytes=8, prototype=define
      Linker and Libraries:
        ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf
-ltcg  -libpath:"c:\perl521\lib\CORE"  -machine:x86'
        libpth="C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\lib"
        libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
        perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib
winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib
oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
        libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl521.lib
        gnulibc_version=''
      Dynamic Linking:
        dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
        cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-opt:ref,icf -ltcg  -libpath:"c:\perl521\lib\CORE"  -machine:x86'

Locally applied patches:
        7494266ea378a3cdc4bfd51725012c1e432db0f1
        61961437d9453dd0d4053ad100e97a029a24edbb
        cd30b936fc5177ce169d776445d09c9898c15da1
        1abbcfa06576bf8a6937c566bb4d18ba803b59d8


@INC for perl 5.21.1:
        C:/perl521/site/lib
        C:/perl521/lib
        .


Environment for perl 5.21.1:
        HOME (unset)
        LANG (unset)
        LANGUAGE (unset)
        LD_LIBRARY_PATH (unset)
        LOGDIR (unset)
        PATH=C:\perl521\bin;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\IDE;C:\Program Files\Microsoft Visual Studio .NET
2003\VC7\BIN;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\Tools;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\Tools\bin\prerelease;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\system32\wbem;
        PERL_BADLANG (unset)
        SHELL (unset)

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @Leont

On Fri, Jul 4, 2014 at 2​:21 AM, bulk88 <perlbug-followup@​perl.org> wrote​:

reflects correcting PerlIOWin32_dup to MS CRT's implementation of dup.
Obviously we want the handle to exist in a child process
(system/backticks/open).

But this branch SEGVs because var os of type PerlIOWin32 * is null.

dumping vars f and o shows f is a ptr to NULL, o is a ptr to something
valid.

I dont have any background in perlio on PP or C level. What are vars
PerlIO *f, PerlIO *o in Dup? what does "f" and "o" mean?
http​://perldoc.perl.org/perliol.html explains nothing.

Unix_dup uses var o first. Win32_dup uses var f first. Should Win32_dup
be using var o first? its not a ptr to NULL unlike var f. IDK.

Yes, it should use o instead of f there. f is the new PerlIO handle that is
being constructed, however at that stage it's still pointing at thing air.
Only after the PerlIOBase_dup it's something remotely usable. o (old?
other?) is pointing to the handle that is being duplicated, so it's
definitely the thing to use to get to the handle that must be duplicated.

I pushed a new patch to that branch, I hope that will get a little further.

Leon

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

On Thu Jul 03 19​:04​:24 2014, LeonT wrote​:

I pushed a new patch to that branch, I hope that will get a little further.

Leon

Slightly better, now an assert fails.


  set PERL_STATIC_EXT=Win32CORE
  cd ..\t
  ..\perl.exe -I..\lib harness
PerlIO layer '​:win32' is experimental.
PerlIO layer '​:win32' is experimental at harness line 13.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 3.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 4.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 5.
PerlIO layer '​:win32' is experimental at ../lib/Carp.pm line 99.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/File/Spec.pm line 4.
PerlIO layer '​:win32' is experimental at ../lib/vars.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/File/Spec.pm line 22.
PerlIO layer '​:win32' is experimental at ../lib/File/Spec/Win32.pm line 6.
PerlIO layer '​:win32' is experimental at ../lib/File/Spec/Unix.pm line 127.
PerlIO layer '​:win32' is experimental at ../lib/File/Spec/Unix.pm line 13.
PerlIO layer '​:win32' is experimental at ../lib/XSLoader.pm line 96.
PerlIO layer '​:win32' is experimental at ../lib/DynaLoader.pm line 22.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 8.
PerlIO layer '​:win32' is experimental at ../lib/File/Path.pm line 6.
PerlIO layer '​:win32' is experimental at ../lib/File/Path.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 9.
PerlIO layer '​:win32' is experimental at ../lib/IO/Handle.pm line 267.
PerlIO layer '​:win32' is experimental at ../lib/IO/Handle.pm line 268.
PerlIO layer '​:win32' is experimental at ../lib/IO/Handle.pm line 269.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Harness.pm line 11.
PerlIO layer '​:win32' is experimental at ../lib/base.pm line 99.
PerlIO layer '​:win32' is experimental at ../lib/base.pm line 99.
PerlIO layer '​:win32' is experimental at (eval 5) line 1.
PerlIO layer '​:win32' is experimental at ../lib/Exporter.pm line 16.
PerlIO layer '​:win32' is experimental at harness line 78.
PerlIO layer '​:win32' is experimental at harness line 18.
PerlIO layer '​:win32' is experimental at ../lib/Config.pm line 80.
PerlIO layer '​:win32' is experimental at ../lib/Config_heavy.pl line 1244.
PerlIO layer '​:win32' is experimental at ./TEST line 399.
PerlIO layer '​:win32' is experimental at harness line 215.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 6.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Grammar.pm line 6.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
6.
PerlIO layer '​:win32' is experimental at ../lib/base.pm line 99.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
8.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
9.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
10.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
11.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
12.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/ResultFactory.pm line
13.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Grammar.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 9.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 10.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 11.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 12.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/SourceHandler/Executa
ble.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Iterator/Process.pm l
ine 84.
PerlIO layer '​:win32' is experimental at ../lib/POSIX.pm line 17.
PerlIO layer '​:win32' is experimental at ../lib/POSIX.pm line 422.
PerlIO layer '​:win32' is experimental at ../lib/base.pm line 99.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 13.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/SourceHandler/Perl.pm
line 12.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 14.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/SourceHandler/File.pm
line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 15.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/SourceHandler/RawTAP.
pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser.pm line 16.
PerlIO layer '​:win32' is experimental at (eval 8) line 2.
PerlIO layer '​:win32' is experimental at ../lib/base.pm line 99.
PerlIO layer '​:win32' is experimental at (eval 9) line 2.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Aggregator.pm line 5.

PerlIO layer '​:win32' is experimental at (eval 11) line 2.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Scheduler.pm line 7.
PerlIO layer '​:win32' is experimental at ../lib/TAP/Parser/Scheduler.pm line 8.
PerlIO layer '​:win32' is experimental at ./TEST line 192.
PerlIO layer '​:win32' is experimental at (eval 12) line 2.
PerlIO layer '​:win32' is experimental at (eval 13) line 2.
PerlIO layer '​:win32' is experimental at ../lib/IPC/Open3.pm line 154.
PerlIO layer '​:win32' is experimental at ../lib/IPC/Open3.pm line 154.
PerlIO layer '​:win32' is experimental at ../lib/IPC/Open3.pm line 334.
PerlIO layer '​:win32' is experimental at ../lib/IO/Handle.pm line 379.
PerlIO layer '​:win32' is experimental at ../lib/IO/Handle.pm line 379.
Assertion failed​: seen, file ..\perlio.c, line 444

This application has requested the Runtime to terminate it in an unusual way.
Please contact the application's support team for more information.
NMAKE : fatal error U1077​: '..\perl.exe' : return code '0x3'
Stop.

C​:\perl521\src\win32>



#ifdef DEBUGGING
# define VERIFY_HEAD(f) PerlIO_verify_head(aTHX_ f)
static void
PerlIO_verify_head(pTHX_ PerlIO *f)
{
  PerlIOl *head, *p;
  int seen = 0;
#ifndef PERL_IMPLICIT_SYS
  PERL_UNUSED_CONTEXT;
#endif
  if (!PerlIOValid(f))
  return;
  p = head = PerlIOBase(f)->head;
  assert(p);
  do {
  assert(p->head == head);
  if (p == (PerlIOl*)f)
  seen = 1;
  p = p->next;
  } while (p);
  assert(seen);<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
}
#else
# define VERIFY_HEAD(f)
#endif


  ntdll.dll!_DbgBreakPoint@​0()
  perl521.dll!PerlIO_verify_head(interpreter * my_perl=0x00364dd4, _PerlIO * * f=0x008f6e2c) Line 445 C
  perl521.dll!PerlIO_push(interpreter * my_perl=0x00364dd4, _PerlIO * * f=0x008f6e2c, _PerlIO_funcs * tab=0x282bbf00, const char * mode=0x0012fc00, sv * arg=0x00364e74) Line 1150 + 0xd C
  perl521.dll!PerlIOBuf_open(interpreter * my_perl=0x00364dd4, _PerlIO_funcs * self=0x282bbf00, PerlIO_list_s * layers=0x008f6c2c, long n=1, const char * mode=0x0012fc00, int fd=9, int imode=0, int perm=0, _PerlIO * * f=0x008f6e2c, int narg=0, sv * * args=0x00000000) Line 3830 + 0x26 C
  perl521.dll!PerlIO_openn(interpreter * my_perl=0x00364dd4, const char * layers=0x00000000, const char * mode=0x0012fc00, int fd=9, int imode=0, int perm=0, _PerlIO * * f=0x00000000, int narg=0, sv * * args=0x00000000) Line 1565 + 0x32 C
  perl521.dll!S_openn_cleanup(interpreter * my_perl=0x00364dd4, gv * gv=0x00ee189c, io * io=0x00dba14c, _PerlIO * * fp=0x008f6e1c, char * mode=0x0012fc00, const char * oname=0x00f3a614, _PerlIO * * saveifp=0x00000000, _PerlIO * * saveofp=0x00000000, int savefd=-1, char savetype=' ', int writing=1, char was_fdopen=0, const char * type=0x00000000) Line 783 + 0x22 C
  perl521.dll!Perl_do_open6(interpreter * my_perl=0x00364dd4, gv * gv=0x00ee189c, const char * oname=0x00f3a614, unsigned int len=19, _PerlIO * * supplied_fp=0x00000000, sv * * svp=0x010330c4, unsigned long num_svs=0) Line 601 + 0x39 C
  perl521.dll!Perl_pp_open(interpreter * my_perl=0x00364dd4) Line 637 + 0x28 C
  perl521.dll!Perl_runops_debug(interpreter * my_perl=0x00364dd4) Line 2360 + 0xd C
  perl521.dll!S_run_body(interpreter * my_perl=0x00364dd4, long oldscope=1) Line 2408 + 0xd C
  perl521.dll!perl_run(interpreter * my_perl=0x00364dd4) Line 2334 C
  perl521.dll!RunPerl(int argc=3, char * * argv=0x00364d70, char * * env=0x00365ed8) Line 258 + 0x9 C++
  perl.exe!main(int argc=3, char * * argv=0x00364d70, char * * env=0x00363390) Line 23 + 0x12 C
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23


PP location is same as before, http​://perl5.git.perl.org/perl.git/blob/smoke-me/leont/perlio-win32​:/dist/IO/lib/IO/Handle.pm#l379

I attached a dump of var f from PerlIO_verify_head's frame.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

var_f_dump.PNG

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

On Thu Jul 03 19​:37​:28 2014, bulk88 wrote​:

I attached a dump of var f from PerlIO_verify_head's frame.

Inside PerlIO_verify_head, there is


  if (p == (PerlIOl*)f)
  seen = 1;


but the cast makes things strange. var f is a PerlIO **, p is a PerlIO *, var f is the realloc permitting indirection layer (the PerlIO **), therefore we shouldn't ever find a PerlIO * and a PerlIO ** that match. Notice 0x00f3a7a4, which is a pointer to the :win32 _PerlIO/PerlIOWin32 struct, does appear in the chain going down from head. Unless the bug is really that f->head should be 0x008f6e2c and not 0x008f6e1c as in the pic.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

On Thu Jul 03 19​:49​:56 2014, bulk88 wrote​:

On Thu Jul 03 19​:37​:28 2014, bulk88 wrote​:

I attached a dump of var f from PerlIO_verify_head's frame.

Inside PerlIO_verify_head, there is

-------------------------------------
if (p == (PerlIOl*)f)
seen = 1;
-------------------------------------

but the cast makes things strange. var f is a PerlIO **, p is a PerlIO
*, var f is the realloc permitting indirection layer (the PerlIO **),
therefore we shouldn't ever find a PerlIO * and a PerlIO ** that
match. Notice 0x00f3a7a4, which is a pointer to the :win32
_PerlIO/PerlIOWin32 struct, does appear in the chain going down from
head. Unless the bug is really that f->head should be 0x008f6e2c and
not 0x008f6e1c as in the pic.

Maybe the bug is PerlIOWin32_dup will return non-NULL/var f if DuplicateHandle fails (returns 0)??? Unix_dup returns PerlIO * NULL if PerlLIO_dup returns a negative number. The error handling logic in PerlIOWin32_dup is to return a non-NULL ptr by default, in Unix_dup the logic is to return NULL by default.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 4, 2014

From @bulk88

Maybe the bug is "new" one after head was introduced in http​://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838 in 2010. PerlIOUnix_open uses
PerlIO_push to fill in var f so f isn't a ptr to null


  if (!f) {
  f = PerlIO_allocate(aTHX);
  }
  if (!PerlIOValid(f)) {
  if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {<<<<<<<<<<<<<<<<<
  PerlLIO_close(fd);
  return NULL;
  }
  }


, PerlIOWin32_open uses http​://perl5.git.perl.org/perl.git/blob/smoke-me/leont/perlio-win32​:/win32/win32io.c#l169 " *f = &s->base;"
--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 5, 2014

From @bulk88

On Fri Jul 04 01​:14​:37 2014, bulk88 wrote​:

Maybe the bug is "new" one after head was introduced in
http​://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838
in 2010. PerlIOUnix_open uses
PerlIO_push to fill in var f so f isn't a ptr to null

------------------------------------------
if (!f) {
f = PerlIO_allocate(aTHX);
}
if (!PerlIOValid(f)) {
if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg)))
{<<<<<<<<<<<<<<<<<
PerlLIO_close(fd);
return NULL;
}
}
------------------------------------------

, PerlIOWin32_open uses http​://perl5.git.perl.org/perl.git/blob/smoke-
me/leont/perlio-win32​:/win32/win32io.c#l169 " *f = &s->base;"

I am not sure that this can be solved without reverting http​://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838 . If all PerlIOl* structs must have a head member, then they (a layer instance) can never be shared between 2 different head layer instances.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 7, 2014

From @iabyn

On Sat, Jul 05, 2014 at 03​:47​:57PM -0700, bulk88 via RT wrote​:

On Fri Jul 04 01​:14​:37 2014, bulk88 wrote​:

Maybe the bug is "new" one after head was introduced in
http​://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838
in 2010. PerlIOUnix_open uses
PerlIO_push to fill in var f so f isn't a ptr to null

------------------------------------------
if (!f) {
f = PerlIO_allocate(aTHX);
}
if (!PerlIOValid(f)) {
if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg)))
{<<<<<<<<<<<<<<<<<
PerlLIO_close(fd);
return NULL;
}
}
------------------------------------------

, PerlIOWin32_open uses http​://perl5.git.perl.org/perl.git/blob/smoke-
me/leont/perlio-win32​:/win32/win32io.c#l169 " *f = &s->base;"

I am not sure that this can be solved without reverting
http​://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838
. If all PerlIOl* structs must have a head member, then they (a layer
instance) can never be shared between 2 different head layer instances.

They are not supposed to be shared. If anything is shared, something has
gone wrong.

A bit of general background explanation - hopefully this will make it
easier for you to decode what' going wrong (I haven't looked hard enough
to determine that).

The basic data type is a layer​:

  typedef struct _PerlIO PerlIOl;

  struct _PerlIO {
  PerlIOl *next; /* Lower layer */
  PerlIO_funcs *tab; /* Functions for this layer */
  U32 flags; /* Various flags for state */
  PerlIOl *head; /* our ultimate parent pointer */
  };

where the layers form a chain of layer->next's.

The perl file handle table PL_perlio is a big array of PerlIOl's, although
only the 'next' field is directly used​: i.e. the first layer isn't stored
as PL_perlio[N]; instead PL_perlio[N].next points to the first layer.

PerlIO is a sort of fake data structure that just contains the address of
the 'next' pointer, i.e. for a file handle f in slot N, you would do

  f = (PerlIO *) &(PL_perlio[N].next);

Maybe some ascii diagrams will help. Consider a file handle f in slot N
which has two layers​:

  PL_perlio

  | |
  N-1 | |
  +-------+ +-------+ +-------+
f ---->| next | --> | next |----> | next | --> NULL
  |(head )| | head | | head |
  N |(tab )| | tab | | tab |
  |(flags)| | flags | | flags |
  +-------+ +-------+ +-------+
  | |
  N+1 | |

Not shown are the two 'head' pointers pointing back to the same thing f is
pointing to.

When a file handle is being duped (e.g. open my $newfh, ">&STDOUT"),
a new empty file handle is created​:

  +-------+
f2---->| next | --> NULL
  |(head )|
  N+1|(tab )|
  |(flags)|
  +-------+

then PerlIOBase_dup() recursively copies each layer, from the bottom up,
using PerlIO_push() to push each new layer. Each push inserts a new layer
between the head and the current top layer. By the end of duplication, it
should look like​:

  PL_perlio

  | |
  N-1 | | +-------+ +-------+
  +-------+ | next |----> | next | --> NULL
f ---->| next | --> | head | | head |
  |(head )| | tab | | tab |
  N |(tab )| | flags | | flags |
  |(flags)| +-------+ +-------+
  +-------+
f2---->| next | --> +-------+ +-------+
  |(head )| | next |----> | next | --> NULL
  N+1 |(tab )| | head | | head |
  |(flags)| | tab | | tab |
  +-------+ | flags | | flags |
  | | +-------+ +-------+
  N+2 | |

PerlIOUnix_dup (and presumably PerlIOWin32_dup) gets called with f being
the new partially constructed filehandle, and o being the current layer
within the original filehandle being duped.

PerlIOUnix_dup() calls the OS-level function to duplicate the physical
file descriptor, then calls PerlIOBase_dup(), which will​: recursively
duplicate any further-down layers (which there aren't in this case), then
return with a new layer pushed at the head of the new handle f.
PerlIOBase_dup() then sets the new fd in this new layer, and returns f.
(I think earlier you mistakenly concluded that PerlIOUnix_dup returns
NULL on success; it in fact returns NULL on failure.)

PerlIO_verify_head() for a handle or layer just checks that all the head
pointers in a layer chain point to the head, i.e.​:

  | | ----<-------------<---------
  | | / \ \
  N-1 | |L \ \
  +-------+ +-------+ / +-------+ /
f ---->| next | | next | / | next | /
  |(head )| | head |- | head |-
  N |(tab )| | tab | | tab |
  |(flags)| | flags | | flags |
  +-------+ +-------+ +-------+
  | |
  N+1 | |
--
My get-up-and-go just got up and went.

@p5pRT
Copy link
Author

p5pRT commented Jul 7, 2014

From @Leont

On Mon, Jul 7, 2014 at 2​:29 PM, Dave Mitchell <davem@​iabyn.com> wrote​:

They are not supposed to be shared. If anything is shared, something has
gone wrong.

A bit of general background explanation - hopefully this will make it
easier for you to decode what' going wrong (I haven't looked hard enough
to determine that).

The basic data type is a layer​:

typedef struct \_PerlIO PerlIOl;

struct \_PerlIO \{
    PerlIOl \*next;          /\* Lower layer \*/
    PerlIO\_funcs \*tab;              /\* Functions for this layer \*/
    U32 flags;                      /\* Various flags for state \*/
    PerlIOl \*head;          /\* our ultimate parent pointer \*/
\};

where the layers form a chain of layer->next's.

The perl file handle table PL_perlio is a big array of PerlIOl's, although
only the 'next' field is directly used​: i.e. the first layer isn't stored
as PL_perlio[N]; instead PL_perlio[N].next points to the first layer.

PerlIO is a sort of fake data structure that just contains the address of
the 'next' pointer, i.e. for a file handle f in slot N, you would do

f = \(PerlIO \*\) &\(PL\_perlio\[N\]\.next\);

I must admit I'm not fond of this design, it's rather confusing IME, a
special purpose struct that has exactly the right fields would be easier to
grok.

Leon

@p5pRT
Copy link
Author

p5pRT commented Jul 9, 2014

From @bulk88

After removing the warning which stops the segv during fork, I got a make test to run, results look bad. And there are 2 different behaviors based on whether I'm redirecting stdio fds to a file using cmd prompt shell or letting them goto console by default. Doing shell redirect to a file gives


  xcopy /f /r /i /d /y ..\perlglob.exe ..\t\
0 File(s) copied
  set PERL_STATIC_EXT=Win32CORE
  cd ..\t
  ..\perl.exe -I..\lib harness
base/cond.t .......................................................
No subtests run
base/if.t .........................................................
No subtests run
base/lex.t ........................................................
No subtests run
base/num.t ........................................................
No subtests run
base/pat.t ........................................................
No subtests run
base/rs.t .........................................................
No subtests run
base/term.t .......................................................
Dubious, test returned 9 (wstat 2304, 0x900)
No subtests run
base/while.t ......................................................
No subtests run
comp/bproto.t .....................................................
No subtests run
comp/cmdopt.t .....................................................
No subtests run
comp/colon.t ......................................................
No subtests run
comp/decl.t .......................................................
No subtests run
comp/final_line_num.t .............................................
No subtests run
comp/fold.t .......................................................
No subtests run
comp/form_scope.t .................................................
No subtests run
comp/hints.t ......................................................
No subtests run
comp/line_debug.t .................................................
No subtests run
comp/multiline.t ..................................................
CUTTTTTTTTTTTTTTTTTTTTTTT
  Parse errors​: No plan found in TAP output
../lib/utf8.t (Wstat​: 0 Tests​: 0 Failed​: 0)
  Parse errors​: No plan found in TAP output
../lib/vars.t (Wstat​: 0 Tests​: 0 Failed​: 0)
  Parse errors​: No plan found in TAP output
../lib/vars_carp.t (Wstat​: 0 Tests​: 0 Failed​: 0)
  Parse errors​: No plan found in TAP output
../lib/vmsish.t (Wstat​: 0 Tests​: 0 Failed​: 0)
  Parse errors​: No plan found in TAP output
../lib/warnings.t (Wstat​: 0 Tests​: 0 Failed​: 0)
  Parse errors​: No plan found in TAP output
Files=2318, Tests=0, 2277 wallclock secs (16.22 usr + 2.58 sys = 18.80 CPU)
Result​: FAIL


The test are running CPU wise.

If I dont redirect IO, the ok/not ok lines are printing in the console. Many not oks are flashing by.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2014

From @bulk88

Flushing a segv fix out of my src tree.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2014

From @bulk88

0001-fix-crash-in-PerlIOWin32_open.patch
From ecafd7654a8d1bc705e8fe0cd3c89044374db045 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 11 Jul 2014 00:10:49 -0400
Subject: [PATCH] fix crash in PerlIOWin32_open

checking if(f) isn't enough, *f also must be checked or it will crash,
use the correct PerlIOValid macro instead of just checking f
---
 win32/win32io.c |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)

diff --git a/win32/win32io.c b/win32/win32io.c
index 5e357b5..9ac2621 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -69,7 +69,7 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
 {
  const char *tmode = mode;
  HANDLE h = INVALID_HANDLE_VALUE;
- if (f)
+ if (PerlIOValid(f))
   {
    /* Close if already open */
    if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2014

From @bulk88

Leont's revert the warning commit has a problem. Turning off the :win32 is default line to get back a regular perl, shows this failing.


C​:\perl521\src\t>.\perl -I../lib harness -v op/caller.t
op/caller.t .. # Failed test 2 - all bits off via "no warnings" at op/caller.t l
ine 114
# got​: \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00
# expected​: \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00
# Failed test 26 - warnings match caller (no bits) at op/caller.t line 115
# got​: \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00
# expected​: \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00

1..95
# Tests with caller(0)
ok 1 - [perl \#68712] filenames after require in a BEGIN block
not ok 2 - all bits off via "no warnings"
ok 3 - default bits on via "use warnings"
ok 4 - warnings match caller (all)
ok 5 - warning bits on via "use warnings​::register"
ok 6 - caller(0) in main program
ok 7 - subroutine name in an eval {}
ok 8 - hasargs false in an eval {}
ok 9 - subroutine name in an eval ''
ok 10 - hasargs false in an eval ''
ok 11 - anonymous subroutine name
ok 12 - hasargs true with anon sub
ok 13 - deleted subroutine name
ok 14 - hasargs true with deleted sub
# Tests with caller(1)
ok 15 - subroutine name
ok 16 - hasargs true with callf()
ok 17 - hasargs false with &callf
ok 18 - subroutine name in an eval {}
ok 19 - hasargs false in an eval {}
ok 20 - subroutine name in an eval ''
ok 21 - hasargs false in an eval ''
ok 22 - anonymous subroutine name
ok 23 - hasargs true with anon sub
ok 24 - deleted subroutine name
ok 25 - hasargs true with deleted sub
not ok 26 - warnings match caller (no bits)
ok 27 - warnings match caller (ahead of w​::r)
ok 28 - warnings match caller (following w​::r)
ok 29 - do not skip over eval (and caller returns 10 elements)
ok 30 - actually return the right function name
ok 31 - do not skip over eval even if $^P had been on at some point
ok 32 - actually return the right function name even if $^P had been on at some
point
# caller can now return the compile time state of %^H
ok 33 - @​DB​::args doesn't leak with $^P = 0
ok 34 - @​DB​::args doesn't leak with $^P = 1
ok 35 - caller does not leak @​DB​::args elems when AvREAL
ok 36 - No crash when @​DB​::args is freed between caller calls
ok 37 - caller dies with tie @​DB​::args
ok 38 - @​DB​::args is still tied
ok 39 - No crash when freed stash is reused for PV with offset hack
ok 40 - eval text returned by caller does not include \n;
ok 41 - [perl \#115768] caller gets line numbers from nulled cops
ok 42 - [perl \#115768] caller gets line numbers from nulled cops (2)
ok 43 - no assertion failure after modifying eval text via caller
ok 44 - here-docs do not gut eval text
ok 45 - here-docs in quote-like ops do not gut eval text
ok 46 - value from (caller 0)[9] (bitmask) works in ${^WARNING_BITS}
ok 47 - caller should not SEGV when the current package is undefined
ok 48 - caller should not SEGV for eval '' stack frames
ok 49
ok 50
ok 51
ok 52
ok 53
ok 54
ok 55
ok 56
ok 57
ok 58
ok 59
ok 60
ok 61
ok 62
ok 63
ok 64
ok 65
ok 66
ok 67
ok 68
ok 69
ok 70
ok 71
ok 72
ok 73
# which now works inside evals
ok 74
ok 75
ok 76
ok 77
ok 78
ok 79
ok 80
ok 81
ok 82 - Can do embedded 0 bytes
ok 83 - Can do Unicode
ok 84 - Can do IVs
ok 85 - Can do UVs
ok 86 - UTF-8 or not, it's the same
ok 87 - UTF-8 or not, it's the same
ok 88 - Octect sequences and UTF-8 are distinct
ok 89 - Octect sequences and UTF-8 are distinct
ok 90 - Keys with the same hash value don't clash
ok 91 - Keys with the same hash value don't clash
ok 92 - Keys with the same hash value don't clash
ok 93 - Keys with the same hash value don't clash
ok 94 - Keys with the same hash value don't clash
ok 95 - Keys with the same hash value don't clash
Failed 2/95 subtests

Test Summary Report


op/caller.t (Wstat​: 0 Tests​: 95 Failed​: 2)
  Failed tests​: 2, 26
Files=1, Tests=95, 0 wallclock secs ( 0.08 usr + 0.00 sys = 0.08 CPU)
Result​: FAIL

C​:\perl521\src\t>


Patch attached.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2014

From @bulk88

0001-fix-Revert-add-a-warning-for-using-the-win32-PerlIO-.patch
From dd45a09fc4fa183e2b9c4afe4f9eb03617554eda Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 11 Jul 2014 11:01:08 -0400
Subject: [PATCH] fix "Revert "add a warning for using the :win32 PerlIO
 layer""

commit 6e9f2f2d7d in caller.t lowered the number of warnings bytes from
16 to 15, but didn't lower it anywhere else, such as in warnings.pm,
probably due to the 2 new warnings (missing, redundant) added after win32 io
layer warning was added, so bump the 15 to 16 to make caller.t pass
---
 t/op/caller.t |    4 ++--
 1 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/t/op/caller.t b/t/op/caller.t
index 54a6bac..c43f576 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -111,8 +111,8 @@ sub testwarn {
 
     # The repetition number must be set to the value of $BYTES in
     # lib/warnings.pm
-    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 15, 'all bits off via "no warnings"' ) }
-    testwarn("\0" x 15, 'no bits');
+    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 16, 'all bits off via "no warnings"' ) }
+    testwarn("\0" x 16, 'no bits');
 
     use warnings;
     BEGIN { check_bits( ${^WARNING_BITS}, $default,
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2014

From @bulk88

On Tue Jul 08 21​:17​:00 2014, bulk88 wrote​:

After removing the warning which stops the segv during fork, I got a
make test to run, results look bad. And there are 2 different
behaviors based on whether I'm redirecting stdio fds to a file using
cmd prompt shell or letting them goto console by default. Doing shell
redirect to a file gives
..............
The test are running CPU wise.

If I dont redirect IO, the ok/not ok lines are printing in the
console. Many not oks are flashing by.

I am trying to fix the harness/IPC​::Open3 can't redirect child process std handles problem. I found a bug, in PerlIOWin32_open, calling win32_open_osfhandle while in "fdopen" mode (IE hading a fd passed to PerlIOWin32_open that is not -1), was reallocing the fd. Since 0,1,2 (std handles) were already open, win32_open_osfhandle was returning fds 3,4, and 5 when PerlIO_stdstreams executed. This causes the PerlLIO_dup2() call in S_openn_cleanup() to never excute, since var saveifp in S_openn_cleanup() was null. saveifp was null because fds 3,4,5 are > PL_maxsysfd (AKA $^F and $SYSTEM_FD_MAX), which is 2 on my machine (and I guess every perl in existence). If the fd is > PL_maxsysfd, in S_openn_setup() (see http​://perl5.git.perl.org/perl.git/blob/ed0e322ca1d56fd4f31e1f778f65732f9e1e7dbb​:/doio.c#l87 ), saveifp will remain NULL, and thus the PerlLIO_dup2() call never happens (I assume :unix perl is the "correct" way to do things, so I am trying to make the :win32 perl do whatever :unix does control flow wise, etc). Also fds 0,1,2 are special cased in MS CRT as using GetStdHandle/SetStdHandle to sync the OS handle in the CRT FD table with the Win32 API's knowledge of what the console handles are.

PerlLIO_dup2() call in S_openn_cleanup() callstack


  perl521.dll!S_openn_cleanup(interpreter * my_perl=0x003645e4, gv * gv=0x008fe24c, io * io=0x008fe25c, _PerlIO * * fp=0x008f573c, char * mode=0x0012fc00, const char * oname=0x00fa93d4, _PerlIO * * saveifp=0x008f569c, _PerlIO * * saveofp=0x00000000, int savefd=0, char savetype='<', int writing=0, char was_fdopen=0, const char * type=0x00000000) Line 699 C
  perl521.dll!Perl_do_open6(interpreter * my_perl=0x003645e4, gv * gv=0x008fe24c, const char * oname=0x00fa93d4, unsigned int len=19, _PerlIO * * supplied_fp=0x00000000, sv * * svp=0x010f0f2c, unsigned long num_svs=0) Line 601 + 0x39 C
  perl521.dll!Perl_pp_open(interpreter * my_perl=0x003645e4) Line 637 + 0x28 C
  perl521.dll!Perl_runops_debug(interpreter * my_perl=0x003645e4) Line 2360 + 0xd C
  perl521.dll!S_run_body(interpreter * my_perl=0x003645e4, long oldscope=1) Line 2403 + 0xd C
  perl521.dll!perl_run(interpreter * my_perl=0x003645e4) Line 2334 C
  perl521.dll!RunPerl(int argc=3, char * * argv=0x00362478, char * * env=0x003629c8) Line 258 + 0x9 C++
  perl.exe!main(int argc=3, char * * argv=0x00362478, char * * env=0x00362d50) Line 23 + 0x12 C
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23


fds 0,1,2 become fds 3,4,5 with this callstack (through PerlIO_stdstreams()) without the patch attached


  perl521.dll!PerlIOWin32_open(interpreter * my_perl=0x003645e4, _PerlIO_funcs * self=0x282bd478, PerlIO_list_s * layers=0x008f54cc, long n=0, const char * mode=0x282accbd, int fd=0, int imode=0, int perm=0, _PerlIO * * f=0x00000000, int narg=0, sv * * args=0x00000000) Line 189 C
  perl521.dll!PerlIOBuf_open(interpreter * my_perl=0x003645e4, _PerlIO_funcs * self=0x282bbf00, PerlIO_list_s * layers=0x008f54cc, long n=1, const char * mode=0x282accbc, int fd=0, int imode=0, int perm=0, _PerlIO * * f=0x00000000, int narg=0, sv * * args=0x00000000) Line 3828 + 0x35 C
  perl521.dll!PerlIO_openn(interpreter * my_perl=0x003645e4, const char * layers=0x00000000, const char * mode=0x282accbc, int fd=0, int imode=0, int perm=0, _PerlIO * * f=0x00000000, int narg=0, sv * * args=0x00000000) Line 1567 + 0x32 C
  perl521.dll!PerlIO_fdopen(int fd=0, const char * mode=0x282accbc) Line 4852 + 0x1d C
  perl521.dll!PerlIO_stdstreams(interpreter * my_perl=0x003645e4) Line 1143 + 0xc C
  perl521.dll!PerlIO_resolve_layers(interpreter * my_perl=0x003645e4, const char * layers=0x00000000, const char * mode=0x28270794, int narg=1, sv * * args=0x0012fb74) Line 1458 + 0x9 C
  perl521.dll!PerlIO_openn(interpreter * my_perl=0x003645e4, const char * layers=0x00000000, const char * mode=0x28270794, int fd=-1, int imode=0, int perm=0, _PerlIO * * f=0x00000000, int narg=1, sv * * args=0x0012fb74) Line 1538 + 0x19 C
  perl521.dll!PerlIO_open(const char * path=0x008f544c, const char * mode=0x28270794) Line 4861 + 0x1d C
  perl521.dll!S_open_script(interpreter * my_perl=0x003645e4, const char * scriptname=0x008f544c, char dosearch=0, char * suidscript=0x0012fc1b) Line 3730 + 0xe C
  perl521.dll!S_parse_body(interpreter * my_perl=0x003645e4, char * * env=0x003629c8, void (interpreter *)* xsinit=0x28233340) Line 2112 + 0x15 C
  perl521.dll!perl_parse(interpreter * my_perl=0x003645e4, void (interpreter *)* xsinit=0x28233340, int argc=3, char * * argv=0x00362478, char * * env=0x003629c8) Line 1593 + 0x11 C
  perl521.dll!RunPerl(int argc=3, char * * argv=0x00362478, char * * env=0x003629c8) Line 251 + 0x1a C++
  perl.exe!main(int argc=3, char * * argv=0x00362478, char * * env=0x00362d50) Line 23 + 0x12 C
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23


I created a crude patch to made :win32 layer open in fdopen mode allocate at the requested fd, kindda. There are a number of problems with the patch, such as not being able to force a particular fd to be used (not sure if this can even be done with the MS CRT), just the 1st one (atleast there is an assert/DebugBreak() to catch if this happens). Also read my comments in the patch.

I'll get to davem's post at https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122224#txn-1300009 later. Right now I have VERIFY_HEAD disabled so I have something to run instead of an instant assert fail.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2014

From @bulk88

On Sun Jul 13 15​:29​:54 2014, bulk88 wrote​:

I created a crude patch to made :win32 layer open in fdopen mode
allocate at the requested fd, kindda. There are a number of problems
with the patch, such as not being able to force a particular fd to be
used (not sure if this can even be done with the MS CRT), just the 1st
one (atleast there is an assert/DebugBreak() to catch if this
happens). Also read my comments in the patch.

forgot patch

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2014

From @bulk88

0001-WIP-dont-commit-fdopen-mode-fix.patch
From 7374111ae13f4be3f77c384a6ed74d26608a6d94 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 13 Jul 2014 17:51:22 -0400
Subject: [PATCH] WIP dont commit, fdopen mode fix

---
 win32/win32io.c |   27 +++++++++++++++++++++++++--
 1 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/win32/win32io.c b/win32/win32io.c
index 9ac2621..c8632e5 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -182,8 +182,31 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
       }
     }
   }
- if (h != INVALID_HANDLE_VALUE)
-  fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
+ if (h != INVALID_HANDLE_VALUE) {
+  int type = GetFileType(h); /* for debugging */
+  /* maybe just look inside pioinfo to see if its open like _PyVerify_fd */
+  int flags = PerlIOUnix_oflags(tmode);
+  int newfd = win32_open_osfhandle((intptr_t) h, flags);
+  if(fd >= 0) { /* we have a mandatory fd to use */
+    if(newfd != fd){
+        if(_get_osfhandle(fd) == h) { /* dont close the OS handle we need to wrap */
+            _set_osfhnd(fd, INVALID_HANDLE_VALUE);
+        }
+        win32_close(fd); /* close it to free the fd we must use */
+    /* close the new fd that was at the wrong fd number, but dont free the OS handle,
+       since the os handle will be used for the new fd at the correct number */
+        _set_osfhnd(newfd, INVALID_HANDLE_VALUE);
+        win32_close(newfd);
+        newfd = win32_open_osfhandle((intptr_t) h, flags);
+        if(newfd != fd){
+            DebugBreak(); /* assert()? what else to do?*/
+        }
+    }
+  }
+  else {
+    fd = newfd; /* not fdopen mode, we dont care about which fd our OS handle winds up at */
+  }
+ }
  if (fd >= 0)
   {
    PerlIOWin32 *s;
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Jul 26, 2014

From @bulk88

part of https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122224

This is a general optimizing/cleanup patch that doesn't contribute to fixing :win32. Unsmoked.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 26, 2014

From @bulk88

0001-remove-redundant-null-assign-in-doio.c-S_openn_clean.patch
From f07c4c3e944423589d8634ea8de6a62ba6f93e3c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sat, 26 Jul 2014 01:51:00 -0400
Subject: [PATCH] remove redundant null assign in doio.c:S_openn_cleanup

IoIFP will be assigned to again in say_false block. This redundant code is
from commit 6e21c824d9 perl 4.0 patch 6.
---
 doio.c |    1 -
 1 files changed, 0 insertions(+), 1 deletions(-)

diff --git a/doio.c b/doio.c
index 46d0796..30b6666 100644
--- a/doio.c
+++ b/doio.c
@@ -782,7 +782,6 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
 	    *s = 'w';
 	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,NULL))) {
 		PerlIO_close(fp);
-		IoIFP(io) = NULL;
 		goto say_false;
 	    }
 	}
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 2014

From @bulk88


$a = sprintf "%" ;
printf F "%\x02" ;
$a = sprintf "%\x02" ;
printf F "%lly" ;
$a = sprintf "%lly" ;
printf F "%25lly" ;
$a = sprintf "%25lly" ;
printf F "%+2Ly" ;
$a = sprintf "%+2Ly" ;
printf F "%+2ll" ;
$a = sprintf "%+2ll" ;
printf F "%+2L\x03" ;
$a = sprintf "%+2L\x03" ;
EXPECTED​:
Invalid conversion in printf​: "%y" at - line 4.
Invalid conversion in sprintf​: "%y" at - line 5.
Invalid conversion in printf​: end of string at - line 6.
Invalid conversion in sprintf​: end of string at - line 7.
Invalid conversion in printf​: "%\002" at - line 8.
Invalid conversion in sprintf​: "%\002" at - line 9.
Invalid conversion in printf​: "%lly" at - line 10.
Invalid conversion in sprintf​: "%lly" at - line 11.
Invalid conversion in printf​: "%25lly" at - line 12.
Invalid conversion in sprintf​: "%25lly" at - line 13.
Invalid conversion in printf​: "%+2Ly" at - line 14.
Invalid conversion in sprintf​: "%+2Ly" at - line 15.
Invalid conversion in printf​: "%+2ll" at - line 16.
Invalid conversion in sprintf​: "%+2ll" at - line 17.
Invalid conversion in printf​: "%+2L\003" at - line 18.
Invalid conversion in sprintf​: "%+2L\003" at - line 19.
GOT​:
Invalid conversion in sprintf​: "%y" at - line 5.
Invalid conversion in sprintf​: end of string at - line 7.
Invalid conversion in sprintf​: "%\002" at - line 9.
Invalid conversion in sprintf​: "%lly" at - line 11.
Invalid conversion in sprintf​: "%25lly" at - line 13.
Invalid conversion in sprintf​: "%+2Ly" at - line 15.
Invalid conversion in sprintf​: "%+2ll" at - line 17.
Invalid conversion in sprintf​: "%+2L\003" at - line 19.
# Failed test 701 - at lib\warnings\sv line 287
../lib/warnings.t ................................................. Failed 3/843
subtests

Test Summary Report


base/term.t (Wstat​: 6400 Tes
ts​: 5 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 7 tests but ran 5.
run/fresh_perl.t (Wstat​: 0 Tests​:
92 Failed​: 1)
  Failed test​: 11
run/switches.t (Wstat​: 0 Tests​:
115 Failed​: 1)
  Failed test​: 9
io/dup.t (Wstat​: 0 Tests​:
29 Failed​: 4)
  Failed tests​: 16, 18, 20, 24
io/fflush.t (Wstat​: 0 Tests​:
5 Failed​: 3)
  Failed tests​: 2-4
  Parse errors​: Bad plan. You planned 7 tests but ran 5.
io/layers.t (Wstat​: 0 Tests​:
46 Failed​: 39)
  Failed tests​: 1-33, 35-40
io/open.t (Wstat​: 0 Tests​:
153 Failed​: 12)
  Failed tests​: 18, 20, 22, 26, 61, 63, 67, 125-128, 137
io/socket.t (Wstat​: 256 Test
s​: 6 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: No plan found in TAP output
io/tell.t (Wstat​: 0 Tests​:
35 Failed​: 1)
  Failed test​: 28
io/utf8.t (Wstat​: 0 Tests​:
63 Failed​: 1)
  Failed test​: 25
op/magic.t (Wstat​: 0 Tests​:
187 Failed​: 1)
  Failed test​: 107
op/readline.t (Wstat​: 0 Tests​:
30 Failed​: 2)
  Failed tests​: 12-13
uni/readline.t (Wstat​: 0 Tests​:
7 Failed​: 2)
  Failed tests​: 4-5
porting/diag.t (Wstat​: 0 Tests​:
1888 Failed​: 3)
  Failed tests​: 1865-1867
porting/podcheck.t (Wstat​: 0 Tests​:
1306 Failed​: 1)
  Failed test​: 177
../cpan/ExtUtils-Constant/t/Constant.t (Wstat​: 256 Test
s​: 30 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 302 tests but ran 30.
../cpan/ExtUtils-MakeMaker/t/basic.t (Wstat​: 512 Test
s​: 84 Failed​: 4)
  Failed tests​: 62, 67, 72, 82
  Non-zero exit status​: 2
  Parse errors​: Bad plan. You planned 171 tests but ran 84.
../cpan/ExtUtils-MakeMaker/t/build_man.t (Wstat​: 6400 Tes
ts​: 5 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 9 tests but ran 5.
../cpan/ExtUtils-MakeMaker/t/echo.t (Wstat​: 6400 Tes
ts​: 0 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: No plan found in TAP output
../cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t (Wstat​: 768 Test
s​: 7 Failed​: 3)
  Failed tests​: 3-5
  Non-zero exit status​: 3
../cpan/ExtUtils-MakeMaker/t/INST.t (Wstat​: 6400 Tes
ts​: 4 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 26 tests but ran 4.
../cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t (Wstat​: 6400 Tes
ts​: 4 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 52 tests but ran 4.
../cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t (Wstat​: 4096 Tes
ts​: 20 Failed​: 16)
  Failed tests​: 3-18
  Non-zero exit status​: 16
../cpan/ExtUtils-MakeMaker/t/min_perl_version.t (Wstat​: 6400 Tes
ts​: 30 Failed​: 8)
  Failed tests​: 5, 7, 9, 11, 14, 26-28
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 36 tests but ran 30.
../cpan/ExtUtils-MakeMaker/t/miniperl.t (Wstat​: 256 Test
s​: 3 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: No plan found in TAP output
../cpan/ExtUtils-MakeMaker/t/MM_Win32.t (Wstat​: 256 Test
s​: 63 Failed​: 1)
  Failed test​: 8
  Non-zero exit status​: 1
../cpan/ExtUtils-MakeMaker/t/pm_to_blib.t (Wstat​: 256 Test
s​: 8 Failed​: 1)
  Failed test​: 8
  Non-zero exit status​: 1
  Parse errors​: No plan found in TAP output
../cpan/ExtUtils-MakeMaker/t/postamble.t (Wstat​: 256 Test
s​: 2 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 8 tests but ran 2.
../cpan/ExtUtils-MakeMaker/t/prereq.t (Wstat​: 256 Test
s​: 3 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 16 tests but ran 3.
../cpan/ExtUtils-MakeMaker/t/recurs.t (Wstat​: 256 Test
s​: 2 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 26 tests but ran 2.
../cpan/ExtUtils-MakeMaker/t/several_authors.t (Wstat​: 256 Test
s​: 3 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 20 tests but ran 3.
../cpan/ExtUtils-MakeMaker/t/VERSION_FROM.t (Wstat​: 256 Test
s​: 0 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 1 tests but ran 0.
../cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t (Wstat​: 256 Test
s​: 4 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 5 tests but ran 4.
../cpan/ExtUtils-MakeMaker/t/writemakefile_args.t (Wstat​: 256 Test
s​: 3 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 43 tests but ran 3.
../cpan/ExtUtils-MakeMaker/t/xs.t (Wstat​: 256 Test
s​: 2 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 5 tests but ran 2.
../cpan/IO-Compress/t/100generic-bzip2.t (Wstat​: 512 Test
s​: 794 Failed​: 2)
  Failed tests​: 525, 527
  Non-zero exit status​: 2
../cpan/IO-Compress/t/100generic-deflate.t (Wstat​: 512 Test
s​: 794 Failed​: 2)
  Failed tests​: 525, 527
  Non-zero exit status​: 2
../cpan/IO-Compress/t/100generic-gzip.t (Wstat​: 512 Test
s​: 794 Failed​: 2)
  Failed tests​: 525, 527
  Non-zero exit status​: 2
../cpan/IO-Compress/t/100generic-rawdeflate.t (Wstat​: 512 Test
s​: 794 Failed​: 2)
  Failed tests​: 525, 527
  Non-zero exit status​: 2
../cpan/IO-Compress/t/100generic-zip.t (Wstat​: 512 Test
s​: 794 Failed​: 2)
  Failed tests​: 525, 527
  Non-zero exit status​: 2
../cpan/IO-Compress/t/105oneshot-bzip2.t (Wstat​: 6400 Tes
ts​: 133 Failed​: 1)
  Failed test​: 133
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 995 tests but ran 133.
../cpan/IO-Compress/t/105oneshot-deflate.t (Wstat​: 6400 Tes
ts​: 133 Failed​: 1)
  Failed test​: 133
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 995 tests but ran 133.
../cpan/IO-Compress/t/105oneshot-gzip.t (Wstat​: 6400 Tes
ts​: 133 Failed​: 1)
  Failed test​: 133
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 995 tests but ran 133.
../cpan/IO-Compress/t/105oneshot-rawdeflate.t (Wstat​: 6400 Tes
ts​: 133 Failed​: 1)
  Failed test​: 133
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 995 tests but ran 133.
../cpan/IO-Compress/t/105oneshot-zip.t (Wstat​: 6400 Tes
ts​: 133 Failed​: 1)
  Failed test​: 133
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 995 tests but ran 133.
../cpan/IO-Compress/t/cz-03zlib-v1.t (Wstat​: 1024 Tes
ts​: 471 Failed​: 4)
  Failed tests​: 438, 441, 446, 449
  Non-zero exit status​: 4
../cpan/IO-Compress/t/cz-14gzopen.t (Wstat​: 512 Test
s​: 264 Failed​: 2)
  Failed tests​: 166, 168
  Non-zero exit status​: 2
../cpan/Test-Harness/t/unicode.t (Wstat​: 6400 Tes
ts​: 0 Failed​: 0)
  Non-zero exit status​: 25
  Parse errors​: No plan found in TAP output
../cpan/Test-Simple/t/Builder/output.t (Wstat​: 256 Test
s​: 6 Failed​: 1)
  Failed test​: 3
  Non-zero exit status​: 1
../cpan/Win32API-File/t/file.t (Wstat​: 0 Tests​:
270 Failed​: 1)
  Failed test​: 21
../cpan/autodie/t/basic_exceptions.t (Wstat​: 256 Test
s​: 19 Failed​: 1)
  Failed test​: 3
  Non-zero exit status​: 1
../cpan/autodie/t/truncate.t (Wstat​: 65280 Te
sts​: 4 Failed​: 0)
  Non-zero exit status​: 255
  Parse errors​: Bad plan. You planned 12 tests but ran 4.
../cpan/autodie/t/utf8_open.t (Wstat​: 65280 Te
sts​: 0 Failed​: 0)
  Non-zero exit status​: 255
  Parse errors​: No plan found in TAP output
../dist/ExtUtils-Install/t/InstallWithMM.t (Wstat​: 256 Test
s​: 2 Failed​: 0)
  Non-zero exit status​: 1
  Parse errors​: Bad plan. You planned 15 tests but ran 2.
../dist/ExtUtils-Manifest/t/Manifest.t (Wstat​: 1792 Tes
ts​: 96 Failed​: 7)
  Failed tests​: 39, 41, 58, 60, 63, 68, 89
  Non-zero exit status​: 7
../dist/Safe/t/safe2.t (Wstat​: 65280 Te
sts​: 28 Failed​: 0)
  Non-zero exit status​: 255
  Parse errors​: No plan found in TAP output
../dist/Storable/t/store.t (Wstat​: 6400 Tes
ts​: 18 Failed​: 3)
  Failed tests​: 14, 16, 18
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 21 tests but ran 18.
../dist/Tie-File/t/09_gen_rs.t (Wstat​: 65280 Te
sts​: 50 Failed​: 0)
  Non-zero exit status​: 255
  Parse errors​: Bad plan. You planned 59 tests but ran 50.
../ext/FileCache/t/03append.t (Wstat​: 512 Test
s​: 2 Failed​: 2)
  Failed tests​: 1-2
  Non-zero exit status​: 2
../ext/IPC-Open3/t/IPC-Open2.t (Wstat​: 0 Tests​:
14 Failed​: 0)
  Parse errors​: Tests out of sequence. Found (3) but expected (2)
  Tests out of sequence. Found (4) but expected (3)
  Tests out of sequence. Found (5) but expected (4)
  Tests out of sequence. Found (6) but expected (5)
  Tests out of sequence. Found (7) but expected (6)
Displayed the first 5 of 14 TAP syntax errors.
Re-run prove with the -p option to see them all.
../lib/ExtUtils/t/Embed.t (Wstat​: 0 Tests​:
7 Failed​: 0)
  Parse errors​: Tests out of sequence. Found (10) but expected (7)
  Bad plan. You planned 10 tests but ran 7.
../lib/warnings.t (Wstat​: 0 Tests​:
843 Failed​: 3)
  Failed tests​: 379, 648, 701
Files=2318, Tests=699319, 13601 wallclock secs (149.17 usr + 4.14 sys = 153.31
CPU)
Result​: FAIL
NMAKE : fatal error U1077​: '..\perl.exe' : return code '0x8f'
Stop.

C​:\perl521\src\win32>


I managed to get harness with :win32 layer to run after adding some new code to doio.c. I will post the code after cleaning it up a bit.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 2014

From @bulk88

On Fri Jul 25 22​:56​:34 2014, bulk88 wrote​:

part of https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122224

This is a general optimizing/cleanup patch that doesn't contribute to
fixing :win32. Unsmoked.

Above patch is obsolete, here is new one.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 2014

From @bulk88

0001-cleanup-perlio.c-and-doio.c.patch
From 68a4b64dc9a9688bb38aabd2dd076a93805c5d0a Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 31 Aug 2014 01:40:27 -0400
Subject: [PATCH] cleanup perlio.c and doio.c

IoIFP will be assigned to again in say_false block. This redundant code is
from commit 6e21c824d9 perl 4.0 patch 6.

in PerlIO_allocate replace a duplicate block with a goto

in PerlIO_resolve_layers replace a func call with a macro, this couldn't
have been using magic due to the previous SvROK
---
 doio.c   |    1 -
 perlio.c |    9 ++++-----
 2 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/doio.c b/doio.c
index 46d0796..30b6666 100644
--- a/doio.c
+++ b/doio.c
@@ -782,7 +782,6 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
 	    *s = 'w';
 	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,NULL))) {
 		PerlIO_close(fp);
-		IoIFP(io) = NULL;
 		goto say_false;
 	    }
 	}
diff --git a/perlio.c b/perlio.c
index f051c1b..53fd5bb 100644
--- a/perlio.c
+++ b/perlio.c
@@ -477,10 +477,7 @@ PerlIO_allocate(pTHX)
 	last = (PerlIOl **) (f);
 	for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
 	    if (!((++f)->next)) {
-		f->flags = 0; /* lockcnt */
-		f->tab = NULL;
-		f->head = f;
-		return (PerlIO *)f;
+		goto good_exit;
 	    }
 	}
     }
@@ -489,6 +486,8 @@ PerlIO_allocate(pTHX)
 	return NULL;
     }
     *last = (PerlIOl*) f++;
+
+    good_exit:
     f->flags = 0; /* lockcnt */
     f->tab = NULL;
     f->head = f;
@@ -1459,7 +1458,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	 * If it is a reference but not an object see if we have a handler
 	 * for it
 	 */
-	if (SvROK(arg) && !sv_isobject(arg)) {
+	if (SvROK(arg) && !SvOBJECT(SvRV(arg))) {
 	    PerlIO_funcs * const handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
 	    if (handler) {
 		def = PerlIO_list_alloc(aTHX);
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 6, 2014

From @bulk88

On Sat Aug 30 22​:42​:14 2014, bulk88 wrote​:

On Fri Jul 25 22​:56​:34 2014, bulk88 wrote​:

part of https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122224

This is a general optimizing/cleanup patch that doesn't contribute to
fixing :win32. Unsmoked.

Above patch is obsolete, here is new one.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2014

From @bulk88

On Sat Sep 06 03​:27​:37 2014, bulk88 wrote​:

On Sat Aug 30 22​:42​:14 2014, bulk88 wrote​:

On Fri Jul 25 22​:56​:34 2014, bulk88 wrote​:

part of https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122224

This is a general optimizing/cleanup patch that doesn't contribute to
fixing :win32. Unsmoked.

Above patch is obsolete, here is new one.

Bump.

Here is different patch for fixing a different :win32 layer issue.

Before
_____________________________________________________
C​:\perl521\src\t>perl -I../lib base/term.t
1..7
ok 1
ok 2
#3 :1​: == :1​:
ok 3
ok 4
ok 5
Can't open /dev/null. at base/term.t line 41.

C​:\perl521\src\t>
_____________________________________________________
After
_____________________________________________________
C​:\perl521\src\t>perl -I../lib base/term.t
1..7
ok 1
ok 2
#3 :1​: == :1​:
ok 3
ok 4
ok 5
ok 6
ok 7

C​:\perl521\src\t>
_____________________________________________________

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2014

From @bulk88

0001-add-dev-null-support-to-win32-io-layer.patch
From 2bfbae23de43234000b13d68be2d6c2e17642f52 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Tue, 9 Sep 2014 10:03:32 -0400
Subject: [PATCH] add /dev/null support to :win32 io layer

:unix layer on Win32 OS supports this, so :win32 also has to. Without this
base/term.t dies with

ok 5
Can't open /dev/null. at base/term.t line 41.

C:\perl521\src\t>

After this, all tests in base/term.t pass when :win32 is the default OS
layer.
---
 pod/perldelta.pod |   13 +++++++++++++
 win32/win32io.c   |    2 ++
 2 files changed, 15 insertions(+), 0 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index f18a30f..9734892 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -336,6 +336,19 @@ L<[perl #120120]|https://rt.perl.org/Ticket/Display.html?id=120120>
 
 =back
 
+=item Win32
+
+=over 4
+
+=item *
+
+In the experimental C<:win32> layer, a crash in C<open> was fixed. Also
+opening C</dev/null>, which works the Win32 Perl's normal C<:unix> layer, was
+implemented for C<:win32>.
+L<[perl #122224]|https://rt.perl.org/Ticket/Display.html?id=122224>
+
+=back
+
 =head1 Internal Changes
 
 XXX Changes which affect the interface available to C<XS> code go here.  Other
diff --git a/win32/win32io.c b/win32/win32io.c
index c8632e5..0342115 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -82,6 +82,8 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
    DWORD  share  = 0;
    DWORD  create = -1;
    DWORD  attr   = FILE_ATTRIBUTE_NORMAL;
+   if (stricmp(path, "/dev/null")==0)
+    path = "NUL";
    if (*mode == '#')
     {
      /* sysopen - imode is UNIX-like O_RDONLY etc.
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2014

From @bulk88

On Sat Aug 30 20​:46​:55 2014, bulk88 wrote​:

I managed to get harness with :win32 layer to run after adding some
new code to doio.c. I will post the code after cleaning it up a bit.

Here is the patch which make console capturing/harness work with :win32 is default perl. It is a simpler alternative but less clean than its alternative of implementing Dup2 vtable entry for Perl IO.

I discussed with leont offline about Dup2 but IIRC he didn't any opinion on it.

I dont want to try to implement Dup2, since it brings up 3 questions.

1. what if the source PIO object has a different stack of layers (​:crlf​:win32) than the destination PIO object(​:crlf​:unix)?

2. AFAIK dup2 requires that FDs (as in what fileno vtable and open vtable in fdreopen mode returns) be fixed in the destination PIO object, how is this identity supposed to be kept in the concept of PerlIO?

3. _dup vtable seems to exist only for interp cloning, not handle cloning, it takes a CLONE_PARAMS *, is it useless for replacing PerlLIO_dup2?

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2014

From @bulk88

0001-WIP-get-harness-console-capture-working-on-win32-lay.patch
From d56c627eaf78528a30b6e2e11f11f4a310f6b738 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Tue, 9 Sep 2014 11:02:14 -0400
Subject: [PATCH] WIP get harness/console capture working on :win32 layer is
 default build

also fix a problem with Test::Builder created PIOs that are layered like

:crlf
:win32
:crlf
:win32

WIP fix on Win32API-File/t/file.t test fail
---
 cpan/Test-Simple/lib/Test/Builder.pm |    4 +++-
 cpan/Win32API-File/t/file.t          |   23 ++++++++++++++++++++++-
 doio.c                               |    3 +++
 embed.fnc                            |    3 +++
 embed.h                              |    5 +++++
 perlio.c                             |   15 +++++++++++++++
 proto.h                              |    7 +++++++
 win32/win32io.c                      |   18 ++++++++++++++++--
 8 files changed, 74 insertions(+), 4 deletions(-)

diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index 00a3ec5..1e9aa5c 100644
--- a/cpan/Test-Simple/lib/Test/Builder.pm
+++ b/cpan/Test-Simple/lib/Test/Builder.pm
@@ -1974,7 +1974,9 @@ sub _copy_io_layers {
 sub _apply_layers {
     my ($fh, @layers) = @_;
     my %seen;
-    my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
+    #not every Perl has :unix as the base layer
+    my $base = PerlIO::base_layer();
+    my @unique = grep { $_ ne $base and !$seen{$_}++ } @layers;
     binmode($fh, join(":", "", "raw", @unique));
 }
 
diff --git a/cpan/Win32API-File/t/file.t b/cpan/Win32API-File/t/file.t
index cbc808c..b23adbc 100644
--- a/cpan/Win32API-File/t/file.t
+++ b/cpan/Win32API-File/t/file.t
@@ -28,6 +28,8 @@ use Win32;
 use File::Spec;
 use Carp;
 use Carp::Heavy;
+use Data::Dumper;
+use Devel::Peek 'Dump';
 
 use Win32API::File qw(:ALL);
 $loaded = 1;
@@ -151,7 +153,26 @@ $ok= print APP "is enough\n";
 $ok or print "# ",fileLastError(),"\n";
 print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 19
 
-SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';
+#Before, SetFilePointer on cygwin only, test fails on Win32 layer perl
+#
+#SV = PV(0x369ffc) at 0xd92c94
+#  REFCNT = 1
+#  FLAGS = (POK,pPOK)
+#  PV = 0xd89eac "\n"
+#  CUR = 1
+#  LEN = 132
+
+
+#After, changed to "if 1;", test then passes on Win32 layer perl
+#
+#SV = PV(0x369ff4) at 0xd91e24
+#  REFCNT = 1
+#  FLAGS = (POK,pPOK)
+#  PV = 0xd89d7c "is enough\r\n"
+#  CUR = 11
+#  LEN = 132
+
+SetFilePointer($h1, 0, [], FILE_BEGIN) if 1;
 
 $ok= ReadFile( $h1, $text, 0, [], [] );
 $ok or print "# ",fileLastError(),"\n";
diff --git a/doio.c b/doio.c
index 30b6666..bf5b6e6 100644
--- a/doio.c
+++ b/doio.c
@@ -700,6 +700,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
 		(void)PerlIO_close(fp);
 		goto say_false;
 	    }
+#ifdef USE_PERLIO
+            win32_synciohandle(saveifp);
+#endif
 #ifdef VMS
 	    if (savefd != PerlIO_fileno(PerlIO_stdin())) {
                 char newname[FILENAME_MAX+1];
diff --git a/embed.fnc b/embed.fnc
index be4f9b7..5464049 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2471,6 +2471,9 @@ ApR	|SSize_t	  |PerlIO_get_cnt	|NULLOK PerlIO *f
 ApR	|PerlIO *|PerlIO_stdin
 ApR	|PerlIO *|PerlIO_stdout
 ApR	|PerlIO *|PerlIO_stderr
+#ifdef WIN32 /* make this disappear on non win32 os layer builds ????? */
+pn	|void	|win32_synciohandle	|NN PerlIO *f
+#endif
 #endif /* PERLIO_LAYERS */
 
 : Only used in dump.c
diff --git a/embed.h b/embed.h
index 263d7cd..ac724dd 100644
--- a/embed.h
+++ b/embed.h
@@ -1739,6 +1739,11 @@
 #define magic_setcollxfrm(a,b)	Perl_magic_setcollxfrm(aTHX_ a,b)
 #define mem_collxfrm(a,b,c)	Perl_mem_collxfrm(aTHX_ a,b,c)
 #  endif
+#  if defined(USE_PERLIO)
+#    if defined(WIN32) /* make this disappear on non win32 os layer builds ????? */
+#define win32_synciohandle	Perl_win32_synciohandle
+#    endif
+#  endif
 #  if defined(_MSC_VER)
 #define magic_regdatum_set(a,b)	Perl_magic_regdatum_set(aTHX_ a,b)
 #  endif
diff --git a/perlio.c b/perlio.c
index 53fd5bb..07c67c8 100644
--- a/perlio.c
+++ b/perlio.c
@@ -333,6 +333,7 @@ void
 Perl_boot_core_PerlIO(pTHX)
 {
     newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
+    /* what should PerlIO::base_layer constant be in PERLIO_IS_STDIO ? */
 }
 
 #endif
@@ -447,6 +448,9 @@ PerlIO_verify_head(pTHX_ PerlIO *f)
 #  define VERIFY_HEAD(f)
 #endif
 
+/* fails with :win32 layer so disable for now */
+#undef VERIFY_HEAD
+#define VERIFY_HEAD(f)
 
 /*
  * Table of pointers to the PerlIO structs (malloc'ed)
@@ -1111,12 +1115,23 @@ PerlIO_default_layers(pTHX)
 void
 Perl_boot_core_PerlIO(pTHX)
 {
+    SV * layer_name;
+    PerlIO_list_t *def;
 #ifdef USE_ATTRIBUTES_FOR_PERLIO
     newXS("io::MODIFY_SCALAR_ATTRIBUTES", XS_io_MODIFY_SCALAR_ATTRIBUTES,
 	  __FILE__);
 #endif
     newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
     newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__);
+
+/* provide a way to find out the default OS layer for this perl */
+    def = PerlIO_default_layers(aTHX);
+    if(def->cur >= 1) {
+        layer_name = newSVpv(def->array[0].funcs->name, 0);
+    } else {
+        layer_name = &PL_sv_undef;
+    }
+    newCONSTSUB(get_hv("PerlIO::", 0), "base_layer", layer_name);
 }
 
 PerlIO_funcs *
diff --git a/proto.h b/proto.h
index 7d3e9e7..77d0dd8 100644
--- a/proto.h
+++ b/proto.h
@@ -8004,6 +8004,13 @@ PERL_CALLCONV SSize_t	Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_
 #define PERL_ARGS_ASSERT_PERLIO_WRITE	\
 	assert(vbuf)
 
+#  if defined(WIN32) /* make this disappear on non win32 os layer builds ????? */
+PERL_CALLCONV void	Perl_win32_synciohandle(PerlIO *f)
+			__attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_WIN32_SYNCIOHANDLE	\
+	assert(f)
+
+#  endif
 #endif
 #if defined(WIN32)
 PERL_CALLCONV char*	Perl_my_setlocale(pTHX_ int category, const char* locale)
diff --git a/win32/win32io.c b/win32/win32io.c
index 0342115..5d08fda 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -48,7 +48,8 @@ PerlIOWin32_popped(pTHX_ PerlIO *f)
 IV
 PerlIOWin32_fileno(pTHX_ PerlIO *f)
 {
- return PerlIOSelf(f,PerlIOWin32)->fd;
+ PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
+ return s->fd;
 }
 
 IV
@@ -404,5 +405,18 @@ PERLIO_FUNCS_DECL(PerlIO_win32) = {
  NULL, /* set_ptrcnt */
 };
 
-#endif
 
+void
+Perl_win32_synciohandle(PerlIO * f) {
+    PerlIOl *l = PerlIOBase(f);
+    PERL_ARGS_ASSERT_WIN32_SYNCIOHANDLE;
+    while(l){
+        if(l->tab == &PerlIO_win32) {
+            PerlIOWin32 *s = (PerlIOWin32*)l;
+            s->h = (HANDLE)_get_osfhandle(s->fd);
+            break;
+        }
+        l = *PerlIONext(&l);
+    }
+}
+#endif
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 12, 2014

From @bulk88

Another PerlIO optimization patch.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 12, 2014

From @bulk88

0001-rmv-redundant-PerlIO_find_layer-from-PerlIO_default_.patch
From 568f0b08dbad76dcd72664e258a9504bcc2b1246 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 12 Sep 2014 13:49:45 -0400
Subject: [PATCH] rmv redundant PerlIO_find_layer from PerlIO_default_layers

Obsolete as of commit fcf2db383b , prior to that commit, PerlIO_find_layer
was needed to convert a PerlIO_funcs * (var osLayer) to a SV * since
PL_def_layerlist wasn't a PerlIO_list_t * but a AV *. After that commit
PerlIO_find_layer returns a PerlIO_funcs *, and we start with a
PerlIO_funcs * (var osLayer), so PerlIO_find_layer is redundant.

Also _NN a stack arg for smaller code.
---
 perlio.c |    9 +++------
 1 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/perlio.c b/perlio.c
index 07c67c8..0d6c257 100644
--- a/perlio.c
+++ b/perlio.c
@@ -886,7 +886,7 @@ XS(XS_PerlIO__Layer__find)
     else {
 	STRLEN len;
 	const char * const name = SvPV_const(ST(1), len);
-	const bool load = (items > 2) ? SvTRUE(ST(2)) : 0;
+	const bool load = (items > 2) ? SvTRUE_NN(ST(2)) : 0;
 	PerlIO_funcs * const layer = PerlIO_find_layer(aTHX_ name, len, load);
 	ST(0) =
 	    (layer) ? sv_2mortal(PerlIO_tab_sv(aTHX_ layer)) :
@@ -1007,8 +1007,7 @@ PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
 	tab = &PerlIO_stdio;
 #endif
     PerlIO_debug("Pushing %s\n", tab->name);
-    PerlIO_list_push(aTHX_ av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
-		     &PL_sv_undef);
+    PerlIO_list_push(aTHX_ av, tab, &PL_sv_undef);
 }
 
 SV *
@@ -1096,9 +1095,7 @@ PerlIO_default_layers(pTHX)
 	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_utf8));
 	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_remove));
 	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_byte));
-	PerlIO_list_push(aTHX_ PL_def_layerlist,
-			 PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
-			 &PL_sv_undef);
+	PerlIO_list_push(aTHX_ PL_def_layerlist, osLayer, &PL_sv_undef);
 	if (s) {
 	    PerlIO_parse_layers(aTHX_ PL_def_layerlist, s);
 	}
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 12, 2014

From @bulk88

A :win32 layer fix patch.

A before and after of the tests that were fixed by changing the file lock behavior.

--- C​:\Documents and Settings\Owner\Desktop\a.txt
+++ C​:\Documents and Settings\Owner\Desktop\b.txt
@​@​ -1,12 +1,5 @​@​
Test Summary Report
-------------------
-base/term.t (Wstat​: 6400 Tes
-ts​: 5 Failed​: 0)
- Non-zero exit status​: 25
- Parse errors​: Bad plan. You planned 7 tests but ran 5.
-run/fresh_perl.t (Wstat​: 0 Tests​:
- 92 Failed​: 1)
- Failed test​: 11
run/switches.t (Wstat​: 0 Tests​:
  115 Failed​: 1)
  Failed test​: 9
@​@​ -46,14 +39,8 @​@​
  1888 Failed​: 3)
  Failed tests​: 1865-1867
porting/podcheck.t (Wstat​: 0 Tests​:
- 1309 Failed​: 7)
- Failed tests​: 1-3, 180, 1307-1309
- Parse errors​: Plan (1..1306) must be at the beginning or end of the TAP output
-
- Bad plan. You planned 1306 tests but ran 1309.
-porting/regen.t (Wstat​: 0 Tests​:
- 42 Failed​: 1)
- Failed test​: 31
+ 1306 Failed​: 1)
+ Failed test​: 177
../cpan/ExtUtils-MakeMaker/t/basic.t (Wstat​: 256 Test
s​: 171 Failed​: 1)
  Failed test​: 127
@​@​ -111,33 +98,14 @​@​
ts​: 471 Failed​: 4)
  Failed tests​: 438, 441, 446, 449
  Non-zero exit status​: 4
-../cpan/IO-Compress/t/cz-14gzopen.t (Wstat​: 512 Test
-s​: 264 Failed​: 2)
- Failed tests​: 166, 168
- Non-zero exit status​: 2
-../cpan/Test-Harness/t/unicode.t (Wstat​: 6400 Tes
-ts​: 0 Failed​: 0)
- Non-zero exit status​: 25
- Parse errors​: No plan found in TAP output
../cpan/Test-Simple/t/Builder/output.t (Wstat​: 256 Test
s​: 6 Failed​: 1)
  Failed test​: 3
  Non-zero exit status​: 1
-../cpan/Win32API-File/t/file.t (Wstat​: 0 Tests​:
- 270 Failed​: 1)
- Failed test​: 21
../cpan/autodie/t/basic_exceptions.t (Wstat​: 256 Test
s​: 19 Failed​: 1)
  Failed test​: 3
  Non-zero exit status​: 1
-../cpan/autodie/t/truncate.t (Wstat​: 65280 Te
-sts​: 4 Failed​: 0)
- Non-zero exit status​: 255
- Parse errors​: Bad plan. You planned 12 tests but ran 4.
-../cpan/autodie/t/utf8_open.t (Wstat​: 65280 Te
-sts​: 0 Failed​: 0)
- Non-zero exit status​: 255
- Parse errors​: No plan found in TAP output
../dist/ExtUtils-Manifest/t/Manifest.t (Wstat​: 1792 Tes
ts​: 96 Failed​: 7)
  Failed tests​: 39, 41, 58, 60, 63, 68, 89
@​@​ -151,10 +119,6 @​@​
  Failed tests​: 14, 16, 18
  Non-zero exit status​: 25
  Parse errors​: Bad plan. You planned 21 tests but ran 18.
-../dist/Tie-File/t/09_gen_rs.t (Wstat​: 65280 Te
-sts​: 50 Failed​: 0)
- Non-zero exit status​: 255
- Parse errors​: Bad plan. You planned 59 tests but ran 50.
../ext/FileCache/t/03append.t (Wstat​: 512 Test
s​: 2 Failed​: 2)
  Failed tests​: 1-2
@​@​ -168,12 +132,12 @​@​
  Parse errors​: Tests out of sequence. Found (10) but expected (7)
  Bad plan. You planned 10 tests but ran 7.
../lib/warnings.t (Wstat​: 0 Tests​:
- 843 Failed​: 3)
- Failed tests​: 379, 648, 701
-Files=2318, Tests=699544, 2478 wallclock secs (154.95 usr + 4.24 sys = 159.19 C
+ 843 Failed​: 1)
+ Failed test​: 379
+Files=2318, Tests=699581, 2515 wallclock secs (152.55 usr + 4.77 sys = 157.31 C
PU)
Result​: FAIL
-NMAKE : fatal error U1077​: '..\perl.exe' : return code '0x7d'
+NMAKE : fatal error U1077​: '..\perl.exe' : return code '0x70'
Stop.

C​:\perl521\src\win32>
\ No newline at end of file

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 12, 2014

From @bulk88

0001-do-not-lock-files-when-doing-open-on-win32-layer.patch
From 101c6642b743a0f82b7806d5a14d645731f1509c Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 12 Sep 2014 15:36:34 -0400
Subject: [PATCH] do not lock files when doing open() on :win32 layer

MS CRT uses _SH_DENYNO flag internally for all open() calls. Not passing
FILE_SHARE_READ and FILE_SHARE_WRITE to CreateFile means we want exclusive
access to the file, otherwise CreateFile fails. Always locking the files
causes :win32 is base layer perl to not be able to have 2
handles/FDs/PIOs open simultaneously to the same disk file. This causes a
behavior different from :unix is base layer win32 perl, and also causes a
number of test fails to fail. See #122224 for details of test fails.
Getting read/write lock on open behavior comes from initial
commit a8c08ecdc5 of win32 layer.
---
 win32/win32io.c |    5 ++---
 1 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/win32/win32io.c b/win32/win32io.c
index 5d08fda..b9f69b3 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -80,7 +80,8 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
   {
    char *path = SvPV_nolen(*args);
    DWORD  access = 0;
-   DWORD  share  = 0;
+   /* CRT uses _SH_DENYNO for open(), this the Win32 equivelent */
+   DWORD  share  = FILE_SHARE_READ | FILE_SHARE_WRITE;
    DWORD  create = -1;
    DWORD  attr   = FILE_ATTRIBUTE_NORMAL;
    if (stricmp(path, "/dev/null")==0)
@@ -143,8 +144,6 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
      SETERRNO(EINVAL,LIB$_INVARG);
      return NULL;
     }
-   if (!(access & GENERIC_WRITE))
-    share = FILE_SHARE_READ;
    h = CreateFile(path,access,share,NULL,create,attr,NULL);
    if (h == INVALID_HANDLE_VALUE)
     {
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 15, 2014

From @rjbs

Okay, so what's up with this ticket?

Right now, it looks like Leon has lost tuits or interest, but bulk88 has not. Probably the least I can do and still be useful is to get bulk88's code up into a smoke-me branch.

Assuming that smokes clean on Win32, what do we expect to happen with this code? Is this in a state that's hoping for merging? Is this just a further elaborate experiment? Obviously there's interest in getting this "done," but I want to be clear on what the imagined next steps are.

bulk88​: If you point me at a remote, it would help me get this into a smoke-me branch today.

--
rjbs

@p5pRT
Copy link
Author

p5pRT commented Sep 15, 2014

From @Leont

On Mon, Sep 15, 2014 at 4​:55 PM, Ricardo SIGNES via RT <
perlbug-followup@​perl.org> wrote​:

Okay, so what's up with this ticket?

Right now, it looks like Leon has lost tuits or interest, but bulk88 has
not. Probably the least I can do and still be useful is to get bulk88's
code up into a smoke-me branch.

I've been kind of busy lately; I haven't had the time yet to look at these
patches in depth yet but I am planning to do so later this week.

Leon

@p5pRT
Copy link
Author

p5pRT commented Sep 16, 2014

From @bulk88

On Mon Sep 15 07​:55​:12 2014, rjbs wrote​:

Okay, so what's up with this ticket?

Right now, it looks like Leon has lost tuits or interest, but bulk88
has not. Probably the least I can do and still be useful is to get
bulk88's code up into a smoke-me branch.

Assuming that smokes clean on Win32, what do we expect to happen with
this code? Is this in a state that's hoping for merging?

Yes.

Is this
just a further elaborate experiment? Obviously there's interest in
getting this "done," but I want to be clear on what the imagined next
steps are.

Assuming :win32 layer becomes stable enough (I am making fixes in it), gets better docs (how to create a :win32 IO object with open()), gets a small amount of tests written for it (specifically I need to test does the result of pushing :win32 onto a :unix layer work (and taking ownership of the kernel handle from the C lib)?). After that I'd like to modify it so all handles made from scratch (IE open) are async, then implement :win32 read and write using ReadFileEx/WriteFileEx, then a WaitForSingleObjectEx so $SIG{ALRM} (reimplemented with SetWaitableTimer) will fire and terminate the block.

Instead of ReadFileEx and WaitForSingleObjectEx, I could rewrite :win32 Open to use NtCreateFile and FILE_SYNCHRONOUS_IO_ALERT flag, which means that all read/write/further operations on the handle can instantly fail if a signal cough cough APC ran on the thread.

But there are 2 problems, Win32 console handles are not kernel IO handles, and are synthesized in user mode using IPC using MS's undocumented clone of Unix domain sockets, so traditional async IO doesn't work on them ever, since it never reaches the kernel (see http​://masm32.com/board/index.php?topic=2552.0 ), instead you must specifically know its a console handle and special case it using console specific function calls.

2nd problem, perl's pipe() calls to MS C lib, and MS C lib always creates blocking pipes (not async pipes), so doing async IO on them will be blocking.

Possible solution, marshall off all :win32 layer reads and writes to a kernel32 thread pool thread?

bulk88​: If you point me at a remote, it would help me get this into a
smoke-me branch today.

https://github.com/bulk88/perl/tree/blead_win32_iolayer

patch "add /dev/null support to :win32 io layer" is different in that branch than attached to this ticket since I had to fix a podcheck.t fail in it. All 4 patches on that branch are not WIPs.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 21, 2014

From @bulk88

On Mon Sep 15 09​:02​:33 2014, LeonT wrote​:

On Mon, Sep 15, 2014 at 4​:55 PM, Ricardo SIGNES via RT <
perlbug-followup@​perl.org> wrote​:

Okay, so what's up with this ticket?

Right now, it looks like Leon has lost tuits or interest, but bulk88 has
not. Probably the least I can do and still be useful is to get bulk88's
code up into a smoke-me branch.

I've been kind of busy lately; I haven't had the time yet to look at these
patches in depth yet but I am planning to do so later this week.

Leon

Any updates?

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 29, 2014

From @bulk88

On Sun Sep 21 07​:06​:35 2014, bulk88 wrote​:

On Mon Sep 15 09​:02​:33 2014, LeonT wrote​:

On Mon, Sep 15, 2014 at 4​:55 PM, Ricardo SIGNES via RT <
perlbug-followup@​perl.org> wrote​:

Okay, so what's up with this ticket?

Right now, it looks like Leon has lost tuits or interest, but bulk88 has
not. Probably the least I can do and still be useful is to get bulk88's
code up into a smoke-me branch.

I've been kind of busy lately; I haven't had the time yet to look at these
patches in depth yet but I am planning to do so later this week.

Leon

Any updates?

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Oct 7, 2014

From @bulk88

On Sun Sep 28 22​:49​:02 2014, bulk88 wrote​:

On Sun Sep 21 07​:06​:35 2014, bulk88 wrote​:

Any updates?

Bump.

Bump. RJBS this branch http​://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-me/bulk88/win32-io-layer should probably be rebased and resmoked again since it has been so long.
--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Oct 8, 2014

From @rjbs

* bulk88 via RT <perlbug-followup@​perl.org> [2014-10-07T01​:50​:58]

RJBS this branch
http​://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-me/bulk88/win32-io-layer
should probably be rebased and resmoked again since it has been so long. --

Your wish is my command.

--
rjbs

@p5pRT
Copy link
Author

p5pRT commented Oct 14, 2014

From @bulk88

On Wed Oct 08 15​:38​:34 2014, perl.p5p@​rjbs.manxome.org wrote​:

* bulk88 via RT <perlbug-followup@​perl.org> [2014-10-07T01​:50​:58]

RJBS this branch
http​://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-
me/bulk88/win32-io-layer
should probably be rebased and resmoked again since it has been so
long. --

Your wish is my command.

Googling www.nntp.perl.org isn't showing any failures that aren't race conditions in time/benchmark related modules so I would like to request this to be rebased/merged to blead.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Oct 21, 2014

From @bulk88

On Tue Oct 14 03​:18​:54 2014, bulk88 wrote​:

On Wed Oct 08 15​:38​:34 2014, perl.p5p@​rjbs.manxome.org wrote​:

* bulk88 via RT <perlbug-followup@​perl.org> [2014-10-07T01​:50​:58]

RJBS this branch
http​://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-
me/bulk88/win32-io-layer
should probably be rebased and resmoked again since it has been so
long. --

Your wish is my command.

Googling www.nntp.perl.org isn't showing any failures that aren't race
conditions in time/benchmark related modules so I would like to
request this to be rebased/merged to blead.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Oct 24, 2014

From @Leont

On Wed, Oct 22, 2014 at 1​:56 AM, bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

Bump.

Patches look good to me.

Leon

@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2014

From @cpansprout

On Fri Oct 24 10​:00​:30 2014, LeonT wrote​:

On Wed, Oct 22, 2014 at 1​:56 AM, bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

Bump.

Patches look good to me.

I have applied them​:

$ git log --oneline -4
d40610d do not lock files when doing open() on :win32 layer
83b69bf add /dev/null support to :win32 io layer
f814d56 rmv redundant PerlIO_find_layer from PerlIO_default_layers
4e0ef34 cleanup perlio.c and doio.c

Thank you.

--

Father Chrysostomos

@p5pRT p5pRT closed this as completed Oct 25, 2014
@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2014

@cpansprout - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant