fixing the launcher

db4
Doug Coleman 2008-03-26 18:47:56 -05:00
parent d4dd93e316
commit 9120865157
5 changed files with 8 additions and 42 deletions

View File

@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.nonblocking io.unix.backend
io.unix.files io.nonblocking sequences kernel namespaces math io.unix.files io.nonblocking sequences kernel namespaces math
system alien.c-types debugger continuations arrays assocs system alien.c-types debugger continuations arrays assocs
combinators unix.process strings threads unix combinators unix.process strings threads unix
io.unix.launcher.parser accessors ; io.unix.launcher.parser accessors io.files ;
IN: io.unix.launcher IN: io.unix.launcher
! Search unix first ! Search unix first
@ -67,6 +67,7 @@ USE: unix
: spawn-process ( process -- * ) : spawn-process ( process -- * )
[ [
current-directory get cd
setup-priority setup-priority
setup-redirection setup-redirection
dup pass-environment? [ dup pass-environment? [

View File

@ -90,4 +90,3 @@ SYMBOLS: +read-only+ +hidden+ +system+
M: windows-nt-io file-info ( path -- info ) M: windows-nt-io file-info ( path -- info )
get-file-information-stat ; get-file-information-stat ;

View File

@ -5,7 +5,7 @@ io.windows io.windows.nt.pipes libc io.nonblocking
io.streams.duplex windows.types math windows.kernel32 windows io.streams.duplex windows.types math windows.kernel32 windows
namespaces io.launcher kernel sequences windows.errors assocs namespaces io.launcher kernel sequences windows.errors assocs
splitting system threads init strings combinators splitting system threads init strings combinators
io.backend accessors concurrency.flags ; io.backend accessors concurrency.flags io.files ;
IN: io.windows.launcher IN: io.windows.launcher
TUPLE: CreateProcess-args TUPLE: CreateProcess-args
@ -27,7 +27,8 @@ TUPLE: CreateProcess-args
"STARTUPINFO" <c-object> "STARTUPINFO" <c-object>
"STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
TRUE >>bInheritHandles ; TRUE >>bInheritHandles
current-directory get >>lpCurrentDirectory ;
: call-CreateProcess ( CreateProcess-args -- ) : call-CreateProcess ( CreateProcess-args -- )
{ {

View File

@ -3,7 +3,7 @@ io.timeouts io.nonblocking io.windows io.windows.nt.backend
kernel libc math threads windows windows.kernel32 kernel libc math threads windows windows.kernel32
alien.c-types alien.arrays sequences combinators combinators.lib alien.c-types alien.arrays sequences combinators combinators.lib
sequences.lib ascii splitting alien strings assocs sequences.lib ascii splitting alien strings assocs
combinators.cleave ; combinators.cleave namespaces ;
IN: io.windows.nt.files IN: io.windows.nt.files
M: windows-nt-io cwd M: windows-nt-io cwd
@ -63,11 +63,12 @@ ERROR: not-absolute-path ;
ERROR: nonstring-pathname ; ERROR: nonstring-pathname ;
ERROR: empty-pathname ; ERROR: empty-pathname ;
USE: tools.walker
M: windows-nt-io normalize-pathname ( string -- string ) M: windows-nt-io normalize-pathname ( string -- string )
dup string? [ nonstring-pathname ] unless dup string? [ nonstring-pathname ] unless
dup empty? [ empty-pathname ] when dup empty? [ empty-pathname ] when
{ { CHAR: / CHAR: \\ } } substitute { { CHAR: / CHAR: \\ } } substitute
cwd swap windows-append-path current-directory get swap windows-append-path
[ "/\\." member? ] right-trim [ "/\\." member? ] right-trim
dup peek CHAR: : = [ "\\" append ] when ; dup peek CHAR: : = [ "\\" append ] when ;

View File

@ -1,36 +0,0 @@
USING: io.files kernel tools.test io.backend
io.windows.nt.files splitting ;
IN: io.windows.nt.tests
[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
[ "c:" ] [ "c:\\" parent-directory ] unit-test
[ "Z:" ] [ "Z:\\" parent-directory ] unit-test
[ "c:" ] [ "c:" parent-directory ] unit-test
[ "Z:" ] [ "Z:" parent-directory ] unit-test
[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test
[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test
[ f ] [ "c:\\foo" root-directory? ] unit-test
[ f ] [ "." root-directory? ] unit-test
[ f ] [ ".." root-directory? ] unit-test
[ ] [ "" resource-path cd ] unit-test
[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test
[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
"C:\\builds\\factor\\12345\\"
"..\\log.txt" windows-append-path
] unit-test
[ "\\\\?\\C:\\builds\\" ] [
"C:\\builds\\factor\\12345\\"
"..\\.." windows-append-path
] unit-test
[ "\\\\?\\C:\\builds\\" ] [
"C:\\builds\\factor\\12345\\"
"..\\.." windows-append-path
] unit-test