changed: #openPipeFor:withMode:errorDisposition:inDirectory:
raise #openError: instead of #openError
--- a/PipeStream.st Fri Oct 26 11:49:17 2012 +0200
+++ b/PipeStream.st Fri Oct 26 11:51:53 2012 +0200
@@ -566,20 +566,20 @@
|blocked pipeFdArray execFdArray execFd myFd shellAndArgs
shellPath shellArgs mbx mbxName
- realCmd execDirectory tmpComFile nullOutput resultPid|
+ realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
handle notNil ifTrue:[
- "the pipe was already open ...
- this should (can) not happen."
- ^ self errorAlreadyOpen
+ "the pipe was already open ...
+ this should (can) not happen."
+ ^ self errorAlreadyOpen
].
rwMode = #r ifTrue:[
- mode := #readonly. didWrite := false.
+ mode := #readonly. didWrite := false.
] ifFalse:[rwMode = #'r+' ifTrue:[
- mode := #readwrite. didWrite := true.
+ mode := #readwrite. didWrite := true.
] ifFalse:[
- mode := #writeonly. didWrite := true.
+ mode := #writeonly. didWrite := true.
]].
lastErrorNumber := nil.
@@ -591,79 +591,79 @@
execFdArray := #(0 1 2) copy.
OperatingSystem isVMSlike ifTrue:[
- "/
- "/ the generated COM-file includes a 'set default'
- "/
- tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
- realCmd := '@' , tmpComFile osName.
- execDirectory := nil.
+ "/
+ "/ the generated COM-file includes a 'set default'
+ "/
+ tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
+ realCmd := '@' , tmpComFile osName.
+ execDirectory := nil.
- mbx := OperatingSystem createMailBox.
- mbx isNil ifTrue:[
- lastErrorNumber := OperatingSystem currentErrorNumber.
- tmpComFile delete.
- ^ self openError
- ].
- mbxName := OperatingSystem mailBoxNameOf:mbx.
+ mbx := OperatingSystem createMailBox.
+ mbx isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ tmpComFile delete.
+ ^ self openError:errorNumber.
+ ].
+ mbxName := OperatingSystem mailBoxNameOf:mbx.
- "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
- shellPath := ''.
- shellArgs := realCmd.
+ "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
+ shellPath := ''.
+ shellArgs := realCmd.
- rwMode = #r ifTrue:[
- "redirect stdout of subprocess to write to mailbox"
- execFdArray at:2 put:mbx.
- ] ifFalse:[
- "redirect stdin of subprocess to read from mailbox"
- execFdArray at:1 put:mbx.
- ].
+ rwMode = #r ifTrue:[
+ "redirect stdout of subprocess to write to mailbox"
+ execFdArray at:2 put:mbx.
+ ] ifFalse:[
+ "redirect stdin of subprocess to read from mailbox"
+ execFdArray at:1 put:mbx.
+ ].
] ifFalse:[
- shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
- shellPath := shellAndArgs at:1.
- shellArgs := shellAndArgs at:2.
+ shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
+ shellPath := shellAndArgs at:1.
+ shellArgs := shellAndArgs at:2.
- mode == #readwrite ifTrue:[
- pipeFdArray := OperatingSystem makeBidirectionalPipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := OperatingSystem currentErrorNumber.
- ^ self openError
- ].
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:1 put:execFd.
- execFdArray at:2 put:execFd.
- ] ifFalse:[
- pipeFdArray := OperatingSystem makePipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := OperatingSystem currentErrorNumber.
- ^ self openError
- ].
+ mode == #readwrite ifTrue:[
+ pipeFdArray := OperatingSystem makeBidirectionalPipe.
+ pipeFdArray isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError:errorNumber.
+ ].
+ myFd := pipeFdArray at:1.
+ execFd := pipeFdArray at:2.
+ execFdArray at:1 put:execFd.
+ execFdArray at:2 put:execFd.
+ ] ifFalse:[
+ pipeFdArray := OperatingSystem makePipe.
+ pipeFdArray isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError:errorNumber.
+ ].
- mode == #readonly ifTrue:[
- "redirect stdout of subprocess to write to pipe"
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:2 put:execFd.
- ] ifFalse:[
- "redirect stdin of subprocess to read from pipe"
- myFd := pipeFdArray at:2.
- execFd := pipeFdArray at:1.
- execFdArray at:1 put:execFd.
- ].
- ].
+ mode == #readonly ifTrue:[
+ "redirect stdout of subprocess to write to pipe"
+ myFd := pipeFdArray at:1.
+ execFd := pipeFdArray at:2.
+ execFdArray at:2 put:execFd.
+ ] ifFalse:[
+ "redirect stdin of subprocess to read from pipe"
+ myFd := pipeFdArray at:2.
+ execFd := pipeFdArray at:1.
+ execFdArray at:1 put:execFd.
+ ].
+ ].
].
errorDisposition == #discard ifTrue:[
- nullOutput := Filename nullDevice writeStream.
- execFdArray at:3 put:nullOutput fileDescriptor
+ nullOutput := Filename nullDevice writeStream.
+ execFdArray at:3 put:nullOutput fileDescriptor
] ifFalse:[
- (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
- execFdArray at:3 put:1
- ] ifFalse:[
+ (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
+ execFdArray at:3 put:1
+ ] ifFalse:[
"/ errorDisposition isStream ifTrue:[
"/self halt.
"/ ].
- ].
+ ].
].
"/ must block here, to avoid races due to early finishing
@@ -673,84 +673,84 @@
"beware: pid may change if subprocess is fast"
pid := resultPid := Processor
- monitor:[
- OperatingSystem
- exec:shellPath
- withArguments:shellArgs
- environment:nil
- fileDescriptors:execFdArray
- fork:true
- newPgrp:true
- inDirectory:execDirectory.
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
+ monitor:[
+ OperatingSystem
+ exec:shellPath
+ withArguments:shellArgs
+ environment:nil
+ fileDescriptors:execFdArray
+ fork:true
+ newPgrp:true
+ inDirectory:execDirectory.
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
- "writing doesn't make sense - there is no reader any longer"
- mode == #readwrite ifTrue:[
- "... but allow to read the rest of the command's output"
- self shutDownOutput.
- ] ifFalse:[mode == #writeonly ifTrue:[
- self closeFileDescriptor.
- ]].
+ "writing doesn't make sense - there is no reader any longer"
+ mode == #readwrite ifTrue:[
+ "... but allow to read the rest of the command's output"
+ self shutDownOutput.
+ ] ifFalse:[mode == #writeonly ifTrue:[
+ self closeFileDescriptor.
+ ]].
- OperatingSystem closePid:pid.
- pid := nil.
- exitSema signal.
- ].
- ].
+ OperatingSystem closePid:pid.
+ pid := nil.
+ exitSema signal.
+ ].
+ ].
"subprocess has been created.
close unused filedescriptors"
execFd notNil ifTrue:[
- OperatingSystem closeFd:execFd.
+ OperatingSystem closeFd:execFd.
].
nullOutput notNil ifTrue:[
- nullOutput close
+ nullOutput close
].
resultPid notNil ifTrue:[
- "successfull creation of subprocesss"
- OperatingSystem isVMSlike ifTrue:[
- "/
- "/ reopen the mailbox as a file ...
- "/
- mbxName := OperatingSystem mailBoxNameOf:mbx.
- mbxName notNil ifTrue:[
- super open:mbxName withMode:rwMode.
- exitAction := [tmpComFile delete].
- ].
- ] ifFalse:[
- self setFileDescriptor:myFd mode:rwMode.
- handleType := #pipeFilePointer.
- ]
+ "successfull creation of subprocesss"
+ OperatingSystem isVMSlike ifTrue:[
+ "/
+ "/ reopen the mailbox as a file ...
+ "/
+ mbxName := OperatingSystem mailBoxNameOf:mbx.
+ mbxName notNil ifTrue:[
+ super open:mbxName withMode:rwMode.
+ exitAction := [tmpComFile delete].
+ ].
+ ] ifFalse:[
+ self setFileDescriptor:myFd mode:rwMode.
+ handleType := #pipeFilePointer.
+ ]
] ifFalse:[
- "creation of subprocesss failed"
- lastErrorNumber := OperatingSystem currentErrorNumber.
- OperatingSystem isVMSlike ifTrue:[
- OperatingSystem destroyMailBox:mbx.
- tmpComFile delete.
- ] ifFalse:[
- OperatingSystem closeFd:myFd.
- ].
+ "creation of subprocesss failed"
+ lastErrorNumber := OperatingSystem currentErrorNumber.
+ OperatingSystem isVMSlike ifTrue:[
+ OperatingSystem destroyMailBox:mbx.
+ tmpComFile delete.
+ ] ifFalse:[
+ OperatingSystem closeFd:myFd.
+ ].
].
blocked ifFalse:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
(resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
- "
- the pipe open failed for some reason ...
- ... this may be either due to an invalid command string,
- or due to the system running out of memory (when forking
- the unix process)
- "
- exitAction value.
- ^ self openError
+ "
+ the pipe open failed for some reason ...
+ ... this may be either due to an invalid command string,
+ or due to the system running out of memory (when forking
+ the unix process)
+ "
+ exitAction value.
+ ^ self openError:lastErrorNumber.
].
commandString := realCmd.
@@ -796,11 +796,11 @@
!PipeStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.111 2010-02-09 18:01:01 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.112 2012-10-26 09:51:53 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.111 2010-02-09 18:01:01 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.112 2012-10-26 09:51:53 stefan Exp $'
! !
PipeStream initialize!