Implement <appender> on Windows
parent
03998fc63b
commit
7f8ee64d28
|
@ -52,6 +52,10 @@ M: winnt CreateFile-flags ( DWORD -- DWORD )
|
||||||
M: winnt FileArgs-overlapped ( port -- overlapped )
|
M: winnt FileArgs-overlapped ( port -- overlapped )
|
||||||
make-overlapped ;
|
make-overlapped ;
|
||||||
|
|
||||||
|
M: winnt open-append
|
||||||
|
[ dup file-info size>> ] [ drop 0 ] recover
|
||||||
|
>r (open-append) r> ;
|
||||||
|
|
||||||
: update-file-ptr ( n port -- )
|
: update-file-ptr ( n port -- )
|
||||||
port-handle
|
port-handle
|
||||||
dup win32-file-ptr [
|
dup win32-file-ptr [
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
IN: io.windows.launcher.nt.tests
|
IN: io.windows.launcher.nt.tests
|
||||||
USING: io.launcher tools.test calendar accessors
|
USING: io.launcher tools.test calendar accessors
|
||||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||||
sequences parser assocs hashtables math ;
|
sequences parser assocs hashtables math continuations ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
|
@ -140,3 +140,18 @@ sequences parser assocs hashtables math ;
|
||||||
|
|
||||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||||
] times
|
] times
|
||||||
|
|
||||||
|
[ "append-test" temp-file delete-file ] ignore-errors
|
||||||
|
|
||||||
|
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||||
|
2 [
|
||||||
|
"resource:extra/io/windows/nt/launcher/test" [
|
||||||
|
<process>
|
||||||
|
vm "-script" "append.factor" 3array >>command
|
||||||
|
"append-test" temp-file <appender> >>stdout
|
||||||
|
try-process
|
||||||
|
] with-directory
|
||||||
|
] times
|
||||||
|
|
||||||
|
"append-test" temp-file ascii file-contents
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -51,6 +51,12 @@ IN: io.windows.nt.launcher
|
||||||
f ! template file
|
f ! template file
|
||||||
CreateFile dup invalid-handle? dup close-always ;
|
CreateFile dup invalid-handle? dup close-always ;
|
||||||
|
|
||||||
|
: redirect-append ( default path access-mode create-mode -- handle )
|
||||||
|
>r >r path>> r> r>
|
||||||
|
drop OPEN_ALWAYS
|
||||||
|
redirect-file
|
||||||
|
dup 0 FILE_END set-file-pointer ;
|
||||||
|
|
||||||
: set-inherit ( handle ? -- )
|
: set-inherit ( handle ? -- )
|
||||||
>r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
|
>r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
|
||||||
|
|
||||||
|
@ -66,7 +72,7 @@ IN: io.windows.nt.launcher
|
||||||
{ [ pick not ] [ redirect-default ] }
|
{ [ pick not ] [ redirect-default ] }
|
||||||
{ [ pick +closed+ eq? ] [ redirect-closed ] }
|
{ [ pick +closed+ eq? ] [ redirect-closed ] }
|
||||||
{ [ pick string? ] [ redirect-file ] }
|
{ [ pick string? ] [ redirect-file ] }
|
||||||
{ [ pick appender? ] [ redirect-file ] }
|
{ [ pick appender? ] [ redirect-append ] }
|
||||||
{ [ pick win32-file? ] [ redirect-handle ] }
|
{ [ pick win32-file? ] [ redirect-handle ] }
|
||||||
[ redirect-stream ]
|
[ redirect-stream ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
USE: io
|
||||||
|
"Hello appender" print
|
|
@ -86,15 +86,13 @@ M: alien close-handle ( handle -- )
|
||||||
f CreateFileW dup win32-error=0/f
|
f CreateFileW dup win32-error=0/f
|
||||||
GetLastError ERROR_ALREADY_EXISTS = not ;
|
GetLastError ERROR_ALREADY_EXISTS = not ;
|
||||||
|
|
||||||
: set-file-pointer ( handle length -- )
|
: set-file-pointer ( handle length method -- )
|
||||||
dupd d>w/w <uint> FILE_BEGIN SetFilePointer
|
>r dupd d>w/w <uint> r> SetFilePointer
|
||||||
INVALID_SET_FILE_POINTER = [
|
INVALID_SET_FILE_POINTER = [
|
||||||
CloseHandle "SetFilePointer failed" throw
|
CloseHandle "SetFilePointer failed" throw
|
||||||
] when drop ;
|
] when drop ;
|
||||||
|
|
||||||
: open-append ( path -- handle length )
|
HOOK: open-append os ( path -- handle length )
|
||||||
[ dup file-info size>> ] [ drop 0 ] recover
|
|
||||||
>r (open-append) r> 2dup set-file-pointer ;
|
|
||||||
|
|
||||||
TUPLE: FileArgs
|
TUPLE: FileArgs
|
||||||
hFile lpBuffer nNumberOfBytesToRead
|
hFile lpBuffer nNumberOfBytesToRead
|
||||||
|
|
Loading…
Reference in New Issue