io.launcher.windows.nt: don't call duplicate-handle, and fix memory leak; io.backend.windows: track win32-handle instances in global win32-handles set to help find leaks

db4
Slava Pestov 2009-08-18 03:46:46 -05:00
parent d7594c3381
commit 5fe3a62446
5 changed files with 46 additions and 19 deletions

View File

@ -4,23 +4,36 @@ USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.ports io.binary io.timeouts system io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise accessors ; splitting continuations math.bitwise accessors init sets assocs ;
IN: io.backend.windows IN: io.backend.windows
: win32-handles ( -- assoc )
\ win32-handles [ H{ } clone ] initialize-alien ;
TUPLE: win32-handle < identity-tuple handle disposed ;
M: win32-handle hashcode* handle>> hashcode* ;
: set-inherit ( handle ? -- ) : set-inherit ( handle ? -- )
[ HANDLE_FLAG_INHERIT ] dip [ handle>> HANDLE_FLAG_INHERIT ] dip
>BOOLEAN SetHandleInformation win32-error=0/f ; >BOOLEAN SetHandleInformation win32-error=0/f ;
TUPLE: win32-handle handle disposed ;
: new-win32-handle ( handle class -- win32-handle ) : new-win32-handle ( handle class -- win32-handle )
new swap [ >>handle ] [ f set-inherit ] bi ; new swap >>handle
dup f set-inherit
dup win32-handles conjoin ;
: <win32-handle> ( handle -- win32-handle ) : <win32-handle> ( handle -- win32-handle )
win32-handle new-win32-handle ; win32-handle new-win32-handle ;
ERROR: disposing-twice ;
: unregister-handle ( handle -- )
win32-handles delete-at*
[ t >>disposed drop ] [ disposing-twice ] if ;
M: win32-handle dispose* ( handle -- ) M: win32-handle dispose* ( handle -- )
handle>> CloseHandle drop ; [ unregister-handle ] [ handle>> CloseHandle win32-error=0/f ] bi ;
TUPLE: win32-file < win32-handle ptr ; TUPLE: win32-file < win32-handle ptr ;

View File

@ -47,10 +47,8 @@ IN: io.files.windows
GetLastError ERROR_ALREADY_EXISTS = not ; GetLastError ERROR_ALREADY_EXISTS = not ;
: set-file-pointer ( handle length method -- ) : set-file-pointer ( handle length method -- )
[ dupd d>w/w <uint> ] dip SetFilePointer [ [ handle>> ] dip d>w/w <uint> ] dip SetFilePointer
INVALID_SET_FILE_POINTER = [ INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ;
CloseHandle "SetFilePointer failed" throw
] when drop ;
HOOK: open-append os ( path -- win32-file ) HOOK: open-append os ( path -- win32-file )

View File

@ -164,4 +164,19 @@ IN: io.launcher.windows.nt.tests
"append-test" temp-file ascii file-contents "append-test" temp-file ascii file-contents
] unit-test ] unit-test
[ "( scratchpad ) " ] [
console-vm "-run=listener" 2array
ascii [ "USE: system 0 exit" print flush readln ] with-process-stream
] unit-test
[ ] [
console-vm "-run=listener" 2array
ascii [ "USE: system 0 exit" print ] with-process-writer
] unit-test
[ ] [
<process>
console-vm "-run=listener" 2array >>command
"vocab:io/launcher/windows/nt/test/input.txt" >>stdin
try-process
] unit-test

View File

@ -10,21 +10,21 @@ IN: io.launcher.windows.nt
: duplicate-handle ( handle -- handle' ) : duplicate-handle ( handle -- handle' )
GetCurrentProcess ! source process GetCurrentProcess ! source process
swap ! handle swap handle>> ! handle
GetCurrentProcess ! target process GetCurrentProcess ! target process
f <void*> [ ! target handle f <void*> [ ! target handle
DUPLICATE_SAME_ACCESS ! desired access DUPLICATE_SAME_ACCESS ! desired access
TRUE ! inherit handle TRUE ! inherit handle
DUPLICATE_CLOSE_SOURCE ! options 0 ! options
DuplicateHandle win32-error=0/f DuplicateHandle win32-error=0/f
] keep *void* ; ] keep *void* <win32-handle> &dispose ;
! /dev/null simulation ! /dev/null simulation
: null-input ( -- pipe ) : null-input ( -- pipe )
(pipe) [ in>> handle>> ] [ out>> dispose ] bi ; (pipe) [ in>> &dispose ] [ out>> dispose ] bi ;
: null-output ( -- pipe ) : null-output ( -- pipe )
(pipe) [ in>> dispose ] [ out>> handle>> ] bi ; (pipe) [ in>> dispose ] [ out>> &dispose ] bi ;
: null-pipe ( mode -- pipe ) : null-pipe ( mode -- pipe )
{ {
@ -49,7 +49,7 @@ IN: io.launcher.windows.nt
create-mode create-mode
FILE_ATTRIBUTE_NORMAL ! flags and attributes FILE_ATTRIBUTE_NORMAL ! flags and attributes
f ! template file f ! template file
CreateFile dup invalid-handle? <win32-file> &dispose handle>> ; CreateFile dup invalid-handle? <win32-file> &dispose ;
: redirect-append ( path access-mode create-mode -- handle ) : redirect-append ( path access-mode create-mode -- handle )
[ path>> ] 2dip [ path>> ] 2dip
@ -58,10 +58,10 @@ IN: io.launcher.windows.nt
dup 0 FILE_END set-file-pointer ; dup 0 FILE_END set-file-pointer ;
: redirect-handle ( handle access-mode create-mode -- handle ) : redirect-handle ( handle access-mode create-mode -- handle )
2drop handle>> duplicate-handle ; 2drop ;
: redirect-stream ( stream access-mode create-mode -- handle ) : redirect-stream ( stream access-mode create-mode -- handle )
[ underlying-handle handle>> ] 2dip redirect-handle ; [ underlying-handle ] 2dip redirect-handle ;
: redirect ( obj access-mode create-mode -- handle ) : redirect ( obj access-mode create-mode -- handle )
{ {
@ -72,7 +72,7 @@ IN: io.launcher.windows.nt
{ [ pick win32-file? ] [ redirect-handle ] } { [ pick win32-file? ] [ redirect-handle ] }
[ redirect-stream ] [ redirect-stream ]
} cond } cond
dup [ dup t set-inherit ] when ; dup [ dup t set-inherit handle>> ] when ;
: redirect-stdout ( process args -- handle ) : redirect-stdout ( process args -- handle )
drop drop

View File

@ -0,0 +1 @@
USE: system 0 exit