Merge git://factorcode.org/git/factor
Eduardo Cavazos
commit
b2aec5aa48
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types arrays continuations destructors io
|
||||
io.windows libc io.nonblocking io.streams.duplex windows.types
|
||||
math windows.kernel32 windows namespaces io.launcher kernel
|
||||
sequences windows.errors assocs splitting system threads init ;
|
||||
io.windows io.windows.pipes libc io.nonblocking
|
||||
io.streams.duplex windows.types math windows.kernel32 windows
|
||||
namespaces io.launcher kernel sequences windows.errors assocs
|
||||
splitting system threads init strings combinators io.backend ;
|
||||
IN: io.windows.launcher
|
||||
|
||||
TUPLE: CreateProcess-args
|
||||
|
|
@ -86,18 +87,73 @@ TUPLE: CreateProcess-args
|
|||
over set-CreateProcess-args-lpEnvironment
|
||||
] when ;
|
||||
|
||||
: (redirect) ( path access-mode create-mode -- handle )
|
||||
>r >r
|
||||
normalize-pathname
|
||||
r> ! access-mode
|
||||
share-mode
|
||||
security-attributes-inherit
|
||||
r> ! create-mode
|
||||
FILE_ATTRIBUTE_NORMAL ! flags and attributes
|
||||
f ! template file
|
||||
CreateFile dup invalid-handle? dup close-later ;
|
||||
|
||||
: redirect ( obj access-mode create-mode -- handle )
|
||||
{
|
||||
{ [ pick not ] [ 3drop f ] }
|
||||
{ [ pick +closed+ eq? ] [ 3drop f ] }
|
||||
{ [ pick string? ] [ (redirect) ] }
|
||||
} cond ;
|
||||
|
||||
: inherited-stdout ( args -- handle )
|
||||
CreateProcess-args-stdout-pipe
|
||||
[ pipe-out ] [ STD_OUTPUT_HANDLE GetStdHandle ] if* ;
|
||||
|
||||
: redirect-stdout ( args -- handle )
|
||||
+stdout+ get GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stdout or ;
|
||||
|
||||
: inherited-stderr ( args -- handle )
|
||||
CreateProcess-args-stdout-pipe
|
||||
[ pipe-out ] [ STD_ERROR_HANDLE GetStdHandle ] if* ;
|
||||
|
||||
: redirect-stderr ( args -- handle )
|
||||
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stderr or ;
|
||||
|
||||
: inherited-stdin ( args -- handle )
|
||||
CreateProcess-args-stdin-pipe
|
||||
[ pipe-in ] [ STD_INPUT_HANDLE GetStdHandle ] if* ;
|
||||
|
||||
: redirect-stdin ( args -- handle )
|
||||
+stdin+ get GENERIC_READ OPEN_EXISTING redirect
|
||||
swap inherited-stdin or ;
|
||||
|
||||
: fill-startup-info
|
||||
dup CreateProcess-args-lpStartupInfo
|
||||
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
|
||||
|
||||
over redirect-stdout over set-STARTUPINFO-hStdOutput
|
||||
over redirect-stderr over set-STARTUPINFO-hStdError
|
||||
over redirect-stdin over set-STARTUPINFO-hStdInput
|
||||
|
||||
drop ;
|
||||
|
||||
: make-CreateProcess-args ( -- args )
|
||||
default-CreateProcess-args
|
||||
wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
|
||||
fill-dwCreateFlags
|
||||
fill-lpEnvironment ;
|
||||
fill-lpEnvironment
|
||||
fill-startup-info ;
|
||||
|
||||
M: windows-io run-process* ( desc -- handle )
|
||||
[
|
||||
make-CreateProcess-args
|
||||
dup call-CreateProcess
|
||||
CreateProcess-args-lpProcessInformation <process>
|
||||
] with-descriptor ;
|
||||
[
|
||||
make-CreateProcess-args
|
||||
dup call-CreateProcess
|
||||
CreateProcess-args-lpProcessInformation <process>
|
||||
] with-descriptor
|
||||
] with-destructors ;
|
||||
|
||||
: dispose-process ( process-information -- )
|
||||
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: alien alien.c-types arrays continuations destructors io
|
|||
io.windows libc io.nonblocking io.streams.duplex windows.types
|
||||
math windows.kernel32 windows namespaces io.launcher kernel
|
||||
sequences windows.errors assocs splitting system
|
||||
io.windows.launcher io.windows.nt.pipes ;
|
||||
io.windows.launcher io.windows.pipes ;
|
||||
IN: io.windows.nt.launcher
|
||||
|
||||
! The below code is based on the example given in
|
||||
|
|
@ -30,17 +30,6 @@ IN: io.windows.nt.launcher
|
|||
dup pipe-out f set-inherit
|
||||
over set-CreateProcess-args-stdin-pipe ;
|
||||
|
||||
: fill-startup-info
|
||||
dup CreateProcess-args-lpStartupInfo
|
||||
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
|
||||
|
||||
over CreateProcess-args-stdout-pipe
|
||||
pipe-out over set-STARTUPINFO-hStdOutput
|
||||
over CreateProcess-args-stdout-pipe
|
||||
pipe-out over set-STARTUPINFO-hStdError
|
||||
over CreateProcess-args-stdin-pipe
|
||||
pipe-in swap set-STARTUPINFO-hStdInput ;
|
||||
|
||||
M: windows-io process-stream*
|
||||
[
|
||||
[
|
||||
|
|
@ -49,7 +38,6 @@ M: windows-io process-stream*
|
|||
|
||||
fill-stdout-pipe
|
||||
fill-stdin-pipe
|
||||
fill-startup-info
|
||||
|
||||
dup call-CreateProcess
|
||||
|
||||
|
|
|
|||
|
|
@ -3,19 +3,11 @@
|
|||
USING: alien alien.c-types arrays destructors io io.windows libc
|
||||
windows.types math windows.kernel32 windows namespaces kernel
|
||||
sequences windows.errors assocs math.parser system random ;
|
||||
IN: io.windows.nt.pipes
|
||||
IN: io.windows.pipes
|
||||
|
||||
! This code is based on
|
||||
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
|
||||
|
||||
: default-security-attributes ( -- obj )
|
||||
"SECURITY_ATTRIBUTES" <c-object>
|
||||
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
|
||||
|
||||
: security-attributes-inherit ( -- obj )
|
||||
default-security-attributes
|
||||
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
|
||||
|
||||
: create-named-pipe ( name mode -- handle )
|
||||
FILE_FLAG_OVERLAPPED bitor
|
||||
PIPE_TYPE_BYTE
|
||||
|
|
@ -4,7 +4,7 @@ USING: alien alien.c-types arrays destructors io io.backend
|
|||
io.buffers io.files io.nonblocking io.sockets io.binary
|
||||
io.sockets.impl windows.errors strings io.streams.duplex kernel
|
||||
math namespaces sequences windows windows.kernel32
|
||||
windows.shell32 windows.winsock splitting ;
|
||||
windows.shell32 windows.types windows.winsock splitting ;
|
||||
IN: io.windows
|
||||
|
||||
TUPLE: windows-nt-io ;
|
||||
|
|
@ -34,6 +34,14 @@ M: windows-io normalize-directory ( string -- string )
|
|||
FILE_SHARE_READ FILE_SHARE_WRITE bitor
|
||||
FILE_SHARE_DELETE bitor ; foldable
|
||||
|
||||
: default-security-attributes ( -- obj )
|
||||
"SECURITY_ATTRIBUTES" <c-object>
|
||||
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
|
||||
|
||||
: security-attributes-inherit ( -- obj )
|
||||
default-security-attributes
|
||||
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
|
||||
|
||||
M: win32-file init-handle ( handle -- )
|
||||
drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ ARTICLE: "tools.test" "Unit testing"
|
|||
$nl
|
||||
"For example, if you were developing a word for computing symbolic derivatives, your unit tests would apply the word to certain input functions, comparing the results against the correct values. While the passing of these tests would not guarantee the algorithm is correct, it would at least ensure that what used to work keeps working, in that as soon as something breaks due to a change in another part of your program, failing tests will let you know."
|
||||
$nl
|
||||
"Unit tests for a vocabulary are placed in test files, named " { $snippet { $emphasis "vocab" } " -tests.factor" } " alongside " { $snippet { $emphasis "vocab" } ".factor" } "; see " { $link "vocabs.loader" } " for details."
|
||||
"Unit tests for a vocabulary are placed in test files, named " { $snippet { $emphasis "vocab" } "-tests.factor" } " alongside " { $snippet { $emphasis "vocab" } ".factor" } "; see " { $link "vocabs.loader" } " for details."
|
||||
$nl
|
||||
"If the test harness needs to define words, they should be placed in the " { $snippet "temporary" } " vocabulary so that they can be forgotten after the tests have been run. Test harness files consist mostly of calls to the following two words:"
|
||||
{ $subsection unit-test }
|
||||
|
|
|
|||
Loading…
Reference in New Issue