smoke-me/leont/perlio-win32 branch #13968
Comments
From @bulk88Created by @bulk88After some offline discussion with leont, he created ------------------------------------------------------------- ------------------------------------------------------------- reflects correcting PerlIOWin32_dup to MS CRT's implementation of dup. 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 at ----------------------------------------------- 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 ----------------------------------------------------- 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 ---------------------------------------------------- if (ref($fd) && "".$fd =~ /GLOB\(/o) { open($io, _open_mode_string($mode) . '&' . $fd)<<<<<<<<<<<<<<<<<<<< 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 ---------------------------------------------------------- Perl Info |
From @LeontOn Fri, Jul 4, 2014 at 2:21 AM, bulk88 <perlbug-followup@perl.org> wrote:
Yes, it should use o instead of f there. f is the new PerlIO handle that is I pushed a new patch to that branch, I hope that will get a little further. Leon |
|
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Thu Jul 03 19:04:24 2014, LeonT wrote:
Slightly better, now an assert fails. set PERL_STATIC_EXT=Win32CORE PerlIO layer ':win32' is experimental at (eval 11) line 2. This application has requested the Runtime to terminate it in an unusual way. C:\perl521\src\win32> #ifdef DEBUGGING ntdll.dll!_DbgBreakPoint@0() 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. -- |
From @bulk88 |
From @bulk88On Thu Jul 03 19:37:28 2014, bulk88 wrote:
Inside PerlIO_verify_head, there is if (p == (PerlIOl*)f) 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. -- |
From @bulk88On Thu Jul 03 19:49:56 2014, bulk88 wrote:
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. -- |
From @bulk88Maybe the bug is "new" one after head was introduced in http://perl5.git.perl.org/perl.git/commit/16865ff7e97c2532fd2001d68cf18909acb0d838 in 2010. PerlIOUnix_open uses if (!f) { , PerlIOWin32_open uses http://perl5.git.perl.org/perl.git/blob/smoke-me/leont/perlio-win32:/win32/win32io.c#l169 " *f = &s->base;" |
From @bulk88On Fri Jul 04 01:14:37 2014, bulk88 wrote:
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. -- |
From @iabynOn Sat, Jul 05, 2014 at 03:47:57PM -0700, bulk88 via RT wrote:
They are not supposed to be shared. If anything is shared, something has A bit of general background explanation - hopefully this will make it The basic data type is a layer: typedef struct _PerlIO PerlIOl; struct _PerlIO { 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 PerlIO is a sort of fake data structure that just contains the address of f = (PerlIO *) &(PL_perlio[N].next); Maybe some ascii diagrams will help. Consider a file handle f in slot N PL_perlio | | Not shown are the two 'head' pointers pointing back to the same thing f is When a file handle is being duped (e.g. open my $newfh, ">&STDOUT"), +-------+ then PerlIOBase_dup() recursively copies each layer, from the bottom up, PL_perlio | | PerlIOUnix_dup (and presumably PerlIOWin32_dup) gets called with f being PerlIOUnix_dup() calls the OS-level function to duplicate the physical PerlIO_verify_head() for a handle or layer just checks that all the head | | ----<-------------<--------- |
From @LeontOn Mon, Jul 7, 2014 at 2:29 PM, Dave Mitchell <davem@iabyn.com> wrote:
I must admit I'm not fond of this design, it's rather confusing IME, a Leon |
From @bulk88After 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\ 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. -- |
From @bulk88Flushing a segv fix out of my src tree. -- |
From @bulk880001-fix-crash-in-PerlIOWin32_open.patchFrom 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
|
From @bulk88Leont'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 1..95 Test Summary Report op/caller.t (Wstat: 0 Tests: 95 Failed: 2) C:\perl521\src\t> Patch attached. -- |
From @bulk880001-fix-Revert-add-a-warning-for-using-the-win32-PerlIO-.patchFrom 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
|
From @bulk88On Tue Jul 08 21:17:00 2014, bulk88 wrote:
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 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 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. -- |
From @bulk88On Sun Jul 13 15:29:54 2014, bulk88 wrote:
forgot patch -- |
From @bulk880001-WIP-dont-commit-fdopen-mode-fix.patchFrom 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
|
From @bulk88part 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. -- |
From @bulk880001-remove-redundant-null-assign-in-doio.c-S_openn_clean.patchFrom 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
|
From @bulk88$a = sprintf "%" ; Test Summary Report base/term.t (Wstat: 6400 Tes 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. -- |
From @bulk88On Fri Jul 25 22:56:34 2014, bulk88 wrote:
Above patch is obsolete, here is new one. -- |
From @bulk880001-cleanup-perlio.c-and-doio.c.patchFrom 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
|
From @bulk88On Sat Aug 30 22:42:14 2014, bulk88 wrote:
Bump. -- |
From @bulk88On Sat Sep 06 03:27:37 2014, bulk88 wrote:
Here is different patch for fixing a different :win32 layer issue. Before C:\perl521\src\t> C:\perl521\src\t> -- |
From @bulk880001-add-dev-null-support-to-win32-io-layer.patchFrom 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
|
From @bulk88On Sat Aug 30 20:46:55 2014, bulk88 wrote:
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? -- |
From @bulk880001-WIP-get-harness-console-capture-working-on-win32-lay.patchFrom 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
|
From @bulk88Another PerlIO optimization patch. -- |
From @bulk880001-rmv-redundant-PerlIO_find_layer-from-PerlIO_default_.patchFrom 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
|
From @bulk88A :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:\perl521\src\win32> -- |
From @bulk880001-do-not-lock-files-when-doing-open-on-win32-layer.patchFrom 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
|
From @rjbsOkay, 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. -- |
From @LeontOn Mon, Sep 15, 2014 at 4:55 PM, Ricardo SIGNES via RT <
I've been kind of busy lately; I haven't had the time yet to look at these Leon |
From @bulk88On Mon Sep 15 07:55:12 2014, rjbs wrote:
Yes.
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?
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. -- |
From @bulk88On Mon Sep 15 09:02:33 2014, LeonT wrote:
Any updates? -- |
From @bulk88On Sun Sep 21 07:06:35 2014, bulk88 wrote:
Bump. -- |
From @bulk88On Sun Sep 28 22:49:02 2014, bulk88 wrote:
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. |
From @rjbs* bulk88 via RT <perlbug-followup@perl.org> [2014-10-07T01:50:58]
Your wish is my command. -- |
From @bulk88On Wed Oct 08 15:38:34 2014, perl.p5p@rjbs.manxome.org wrote:
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. -- |
From @bulk88On Tue Oct 14 03:18:54 2014, bulk88 wrote:
Bump. -- |
From @LeontOn Wed, Oct 22, 2014 at 1:56 AM, bulk88 via RT <perlbug-followup@perl.org>
Patches look good to me. Leon |
From @cpansproutOn Fri Oct 24 10:00:30 2014, LeonT wrote:
I have applied them: $ git log --oneline -4 Thank you. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#122224 (status was 'resolved')
Searchable as RT122224$
The text was updated successfully, but these errors were encountered: