[ENH][GOODIE][VM] OSProcess V3.0.6 (updated for Squeak 3.6)

David T. Lewis lewis at mail.msen.com
Mon Jul 21 03:38:19 UTC 2003


This is in incremental update to OSProcess 3.0.5.

This update contains several fixes and changes to support Squeak 3.6.
It also includes an important bug fix for OSPP 3.0.5. All other versions
are OK, including the current SAR on Squeak Map.

The current version of OSProcess may also be loaded directly from Squeak Map.

Changes since 3.0.5:

- Fixed an error in the Unix signal handler (due to a typo by yours truly in
the last patch release, version 3.0.5). Without this fix, it is possible for the VM
to exit without any error message or stack trace (this is the 'normal' behavior
of the VM on receipt of a SIGPIPE signal). I am not aware of this happening in
practice for any current OSProcess users, but it did happen to me in the course
of reimplement some new CommandShell pipeline methods, so I consider this an
important fix.

- Made various fixes to maintain compatibility with VMMaker code generation.

- Fixed OSProcessPlugin class>>installedModule so it works even if the plugin
classes were loaded without VMMaker (in which case InterpreterPlugin does
not exist in the image).

- Made a minor change to follow PackageInfo naming conventions for
StandardFileStream>>fileID.

- Fixed undeclared references (classes in CommandShell and IOHandle).

- Update version numbers for OSProcess and OSProcessPlugin.

Dave

-------------- next part --------------
'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5325] on 18 July 2003 at 9:59:38 am'!
"Change Set:		OSProcessV3-0-6-dtl
Date:			18 July 2003
Author:			David T. Lewis

This is in incremental update to OSProcess 3.0.5.
This update includes an important bug fix for OSPP 3.0.5. All other versions
are OK, including the current SAR on Squeak Map.

Changes since 3.0.5:

- Fixed an error in the Unix signal handler (due to a typo by yours truly in
the last patch release, version 3.0.5). Without this fix, it is possible for the VM
to exit without any error message or stack trace (this is the 'normal' behavior
of the VM on receipt of a SIGPIPE signal). I am not aware of this happening in
practice for any current OSProcess users, but it did happen to me in the course
of reimplement some new CommandShell pipeline methods, so I consider this an
important fix.

- Made various fixes to maintain compatibility with VMMaker code generation.

- Fixed OSProcessPlugin class>>installedM!
 odule so it works even if the plugin
classes were loaded without VMMaker (in which case InterpreterPlugin does
not exist in the image).

- Made a minor change to follow PackageInfo naming conventions for
StandardFileStream>>fileID.

- Fixed undeclared references (classes in CommandShell and IOHandle).

- Update version numbers for OSProcess and OSProcessPlugin.
"!


!OSProcess class methodsFor: 'version testing' stamp: 'dtl 7/13/2003 14:57'!
versionInformation

	"OSProcess versionInformation"

	| osppVersion |
	osppVersion _ (Smalltalk hasClassNamed: #OSProcessPlugin)
		ifTrue:
			[(Smalltalk at: #OSProcessPlugin) installedModule]
		ifFalse:
			['(not installed in this image)'].
	^ Array
		with: (self name, ' version ', self versionString)
		with: ((Smalltalk hasClassNamed: #CommandShell)
				ifTrue:
					[((Smalltalk at: #CommandShell) respondsTo: #versionString)
						ifTrue:
							['CommandShell version ', (Smalltalk at: #CommandShell) versionString]
						ifFalse:
				!
 			['CommandShell installed (old version, no versionString)']]!
 
				ifF
alse:
					['CommandShell is not installed'])
		with:  osppVersion
! !

!OSProcess class methodsFor: 'version testing' stamp: 'dtl 7/12/2003 11:09'!
versionString

	"OSProcess versionString"

	^'3.0.6'! !


!ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 7/12/2003 11:38'!
command: aCommandString

	"ExternalUnixOSProcess command: 'ls -l /etc'"

	^ self forkAndExec: self defaultShellPath
		arguments: (Array with: '-c' with: aCommandString)
		environment: nil! !


!OSProcessAccessor methodsFor: 'private - IOHandle' stamp: 'dtl 7/12/2003 12:17'!
ioAccessorFromSQFile: aByteArray
	"Answer an object which represents an IO channel. If IOHandle is present in
	this image, use it; otherwise just answer aByteArray."

	UseIOHandle
		ifTrue: [^ (Smalltalk at: #IOHandle) newFromSqFileStruct: aByteArray]
		ifFalse: [^ aByteArray]! !


!OSProcessPlugin methodsFor: 'primitives - OS process access' stamp: 'dtl 7/14/2003 19:44'!
primitiveGetSession
	"Answer the unique s!
 ession identifier for this Smalltalk instance running in this
	OS process. The C integer value is coerced into a Smalltalk ByteArray to preserve
	the full range of possible values."

	| sessionOop sessionByteArrayPointer thisSessionID |
	self export: true.
	self var: 'sessionByteArrayPointer' declareC: 'unsigned char *sessionByteArrayPointer'.
	self var: 'copyByteArrayPointer' declareC: 'unsigned char *copyByteArrayPointer'.
	sessionOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self sizeOfInt.
	sessionByteArrayPointer _ interpreterProxy arrayValueOf: sessionOop.
	thisSessionID _ self getThisSessionIdentifier.
	thisSessionID isNil ifTrue:
		[^ interpreterProxy primitiveFail].	"The session ID is not permitted to be zero"
	self copyBytesFrom: (self cCode: '(unsigned char *)&thisSessionID' inSmalltalk: [thisSessionID])
		to: sessionByteArrayPointer
		length: self sizeOfInt.
	interpreterProxy pop: 1; push: sessionOop
! !

!OSProcessPlugi!
 n methodsFor: 'primitives - machine specific' stamp: 'dtl 7/14!
 /2003 06
:32'!
primitiveSizeOfInt
	"Size in bytes of an integer, for this C compiler on this machine."

	self export: true.
	interpreterProxy pop: 1; pushInteger: self sizeOfInt! !

!OSProcessPlugin methodsFor: 'primitives - machine specific' stamp: 'dtl 7/14/2003 06:33'!
primitiveSizeOfPointer
	"Size in bytes of a void pointer, for this C compiler on this machine."

	self export: true.
	interpreterProxy pop: 1; pushInteger: self sizeOfPointer! !

!OSProcessPlugin methodsFor: 'version identification' stamp: 'dtl 7/14/2003 05:48'!
versionString
	"Answer a string containing the version string for this plugin. Handle MNU
	errors, which can occur if class InterpreterPlugin has been removed from
	the system.

	Important: When this method is changed, the class side method must also be
	changed to match."

	| version |
	self returnTypeC: 'char *'.
	self var: 'version' declareC: 'static char version[]= "3.0.6"'.
	^ self cCode: 'version' inSmalltalk: [self class versionString]
! !

!OSProcess!
 Plugin methodsFor: 'private - conversion' stamp: 'dtl 7/14/2003 19:45'!
copyBytesFrom: charArray1 to: charArray2 length: len

	"| chars |
	chars _ 'abcd'.
	self new copyBytesFrom: 'wxyz' to: chars length: 4.
	chars"

	| p1 p2 idx |
	self var: 'charArray1' type: 'unsigned char *'.
	self var: 'charArray2' type: 'unsigned char *'.
	self var: 'p1' declareC: 'unsigned char *p1'.
	self var: 'p2' declareC: 'unsigned char *p2'.
	self cCode: 'p1 = charArray1' inSmalltalk: [p1 _ 1].
	self cCode: 'p2 = charArray2' inSmalltalk: [p2 _ 1].
	idx _ 0.
	[idx < len] whileTrue:
		[self cCode: '*p2 = *p1'
			inSmalltalk: [charArray2 at: p2 put: (charArray1 at: p1)].
		p1 _ p1 + 1.
		p2 _ p2 + 1.
		idx _ idx + 1]
! !

!OSProcessPlugin methodsFor: 'private - conversion' stamp: 'dtl 7/14/2003 06:31'!
sizeOfInt
	"Size in bytes of an integer, for this C compiler on this machine."

	^ self cCode: 'sizeof(int)' inSmalltalk: [4]
! !

!OSProcessPlugin methodsFor: 'private - conversion' stamp: 'dtl 7/14!
 /2003 06:32'!
sizeOfPointer
	"Size in bytes of a void pointer,!
  for thi
s C compiler on this machine."

	^ self cCode: 'sizeof(void *)' inSmalltalk: [4].
! !


!OSProcessPlugin class methodsFor: 'version identification' stamp: 'dtl 7/14/2003 05:46'!
versionString
	"Version numbering is independent of OSProcess class>>versionString, and should be
	changed only when the plugin changes. Version numbers will begin arbitrarily
	with 2.1 as of OSProcess 2.7. See the instance side version of this method for the
	implementation.

	Important: When this method is changed, the instance side method must also be
	changed to match."

	"OSProcessPlugin versionString"

	^ '3.0.6'! !


!UnixOSProcessPlugin methodsFor: 'primitives - OS process access' stamp: 'dtl 7/14/2003 19:43'!
primitiveReapChildProcess
	"Clean up after the death of a child, and answer an array with the pid and
	the exit status of the child process. Answer nil if the pidToHandle does not exist."

	| pidToHandle pidResult exitStatus resultArray arrayPtr |
	self export: true.
	self var: 'arrayPt!
 r' declareC: 'int *arrayPtr'.
	exitStatus _ 0.	"Force C code translator to declare the variable"
	pidToHandle _ interpreterProxy stackIntegerValue: 0.
	pidResult _ self cCode: 'waitpid ( pidToHandle, &exitStatus, WNOHANG )'
					inSmalltalk: [ exitStatus _ -1 ].
	pidResult <= 0
		ifTrue: [ interpreterProxy pop: 2; push: interpreterProxy nilObject ]
		ifFalse: [ "Answer an array with pid and result status "
			resultArray _ interpreterProxy
							instantiateClass: interpreterProxy classArray
							indexableSize: 2.
			arrayPtr _ interpreterProxy firstIndexableField: resultArray.
			self cCode: 'arrayPtr[0] = integerObjectOf(pidResult)'
				inSmalltalk: [resultArray at: 1 put: pidResult].
			self cCode: 'arrayPtr[1] = integerObjectOf(exitStatus)'
				inSmalltalk: [resultArray at: 2 put: exitStatus].
			interpreterProxy pop: 2; push: resultArray ]
! !

!UnixOSProcessPlugin methodsFor: 'private - signum' stamp: 'dtl 7/12/2003 11:07'!
sigIgnoreNumber
	"Ignore action for a sign!
 al"

	self returnTypeC: 'void *'.
	^ self cCode: 'SIG_IGN' inS!
 malltalk
: [1]
! !


!UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 11:51'!
command: aCommandString input: aStreamOrString
	"Run a command in a shell process. Similar to the system(3) call in the standard C library,
	except that aCommandString runs asynchronously in a child process."

	"OSProcess thisOSProcess
		command: 'cat'
		input: 'this is some test data'"

	"OSProcess thisOSProcess
		command: 'cat'
		input: (ReadStream on: 'this is some test data')"

	| proc |
	(Smalltalk hasClassNamed: #PipeableOSProcess)
		ifTrue:
			[proc _ (Smalltalk at: #PipeableOSProcess) command: aCommandString.
			proc ifNil: [^ nil].
			proc nextPutAll: aStreamOrString contents.
			proc pipeToInput close.
			^ proc]
		ifFalse:
			[self notify: 'the #command:input: method requires CommandShell, using #command: instead'.
			^ self command: aStreamOrString contents]

! !

!UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 12:06'!
waitForCommandOutput!
 : aCommandString 
	"Run a command in a shell process. Similar to the system(3) call in the 
	standard C library. The active Smalltalk process waits for completion of
	the external command process."

	"OSProcess thisOSProcess waitForCommandOutput: 'echo sleeping...; sleep 1; echo I just slept for one second'"
	"OSProcess thisOSProcess waitForCommandOutput: 'ThisIsABogusCommand'"
	"OSProcess thisOSProcess waitForCommandOutput: '/bin/ls -l /etc /bin'"
	"OSProcess thisOSProcess waitForCommandOutput: 'echo Hello world!!; ls /NOSUCHFILE'"

	(Smalltalk hasClassNamed: #PipeableOSProcess)
		ifTrue:
			[^ ((Smalltalk at: #PipeableOSProcess) command: aCommandString) output]
		ifFalse:
			[self notify: 'the #waitForCommandOutput: method requires CommandShell'.
			^ '']
! !

!UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 12:08'!
waitForCommandOutputArray: aCommandString
	"Run a command in a shell process. Similar to the system(3) call in the standard C libr!
 ary.
	The active Smalltalk process waits for completion of the!
  externa
l command process."

	"OSProcess thisOSProcess waitForCommandOutputArray: 'echo Hello world!!; ls /NOSUCHFILE'"

	| proc |
	(Smalltalk hasClassNamed: #PipeableOSProcess)
		ifTrue:
			[proc _ (Smalltalk at: #PipeableOSProcess) command: aCommandString.
			^ Array
				with: proc output
				with: proc errorUpToEnd
				with: proc processProxy exitStatus]
		ifFalse:
			[self notify: 'the #waitForCommandOutputArray: method requires CommandShell'.
			^ Array with: '' with: '' with: nil]
! !


!UnixProcess class methodsFor: 'utility' stamp: 'dtl 7/13/2003 14:47'!
startSwiki: aSwiki onPort: num loggingTo: aFileName
	"Start a swiki in a headless Squeak image."

	"UnixProcess startSwiki: 'myswiki' onPort: 8081 loggingTo: 'log.txt'"

	| proc |
	(Smalltalk hasClassNamed: #SwikiAction)
		ifTrue:
			[proc _ self forkSqueakAndDo:
				[(Smalltalk at: #SwikiAction) new restore: 'myswiki'.
				(Smalltalk at: #PWS) serveOnPort: num loggingTo: aFileName.
				UnixProcess decapitate].
			proc ifNil!
 : [self noAccessorAvailable].
			^ proc]
		ifFalse:
		[self notify: 'PWS not installed in this image']
! !

!UnixProcess class methodsFor: 'unit tests' stamp: 'dtl 7/12/2003 12:13'!
runTests
	"Run a few tests to see if things are working correctly on Unix/Linux. 
	Output is on stdout, stderr, and the Squeak Transcript. One of the tests 
	requires input from stdin, so Squeak should be run from a shell command
	line and not as a background process.

	Warning: This test will crash your VM if your are using the -xshm command
	line option. For reasons which I do not quite understand, the X shared
	memory segment becomes invalid when the Squeak VM which initially
	opened the shared memory exits. The remaining Squeak children will crash
	when then then next try to update the display.

	Note: If you see 'select: Bad file descriptor' messages on your console standard
	output, these are occuring while running headless in the decapitate/recapitate
	tests.

	Important: Prior to evaluat!
 ing this method, please type one line of text
	followed by a <!
 cr> on t
he terminal standard input. This provides the
	input for the stdin test. Failing to provide this input prior to evaluating
	the tests will cause one of the test cases to fail."

	"UnixProcess runTests"

	| this s p failures result a |
	failures _ 0.
	Transcript show: 'Begin OSProcess tests'; cr.
	Transcript show: 'Test for working ProcessAccessor ... '.
	this _ OSProcess thisOSProcess.
	(this pid isKindOf: Integer)
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'Echo one line of text previously entered from stdin ... '.
	s _ OSProcess readFromStdIn.
	s size > 0
		ifTrue: [Transcript show: 'OK'; cr; show: s; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'Message to stdout ... '.
	(OSProcess helloWorld isKindOf: AttachableFileStream)
		ifTrue: [Transcript show: 'OK'; cr; show: s; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript s!
 how: 'Message to stderr ... '.
	(OSProcess helloStdErr isKindOf: AttachableFileStream)
		ifTrue: [Transcript show: 'OK'; cr; show: s; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess cataFile ... '.
	p _ UnixProcess catAFile.
	(Delay forSeconds: 1) wait.
	p exitStatus == 0
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess testEnvSet ... '.
	p _ UnixProcess testEnvSet.
	(Delay forSeconds: 1) wait.
	p exitStatus == 0
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess catFromFileToFiles ... '.
	OSProcess command: 'rm /tmp/deleteMe.out'.
	OSProcess command: 'rm /tmp/deleteMe.err'.
	p _ UnixProcess catFromFileToFiles.
	(Delay forSeconds: 1) wait.
	p exitStatus == 0
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures !
 + 1].
	Transcript show: 'UnixProcess testRunCommand ... '.
	OS!
 Process 
command: 'rm /tmp/deleteMe.out'.
	OSProcess command: 'rm /tmp/deleteMe.err'.
	p _ UnixProcess testRunCommand.
	(Delay forSeconds: 1) wait.
	p exitStatus == 256
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess testPipe ... '.
	UnixProcess testPipe = 'this is some text to write into the pipe'
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess testPipeLine ... '.
	UnixProcess testPipeLine = 'This is the text to write out through one pipe, copy through an external cat command, and then read back in through another pipe.'
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess spawnTenHeadlessChildren ... '.
	p _ UnixProcess spawnTenHeadlessChildren.
	(p size == 10 and: [(p select: [:e | (e runState == #running) | (e exitStatus == 0)])!
  size == 10])
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess cloneSqueak ... '.
	p _ UnixProcess cloneSqueak.
	(p isKindOf: UnixProcess)
		ifTrue: 
			[(Delay forSeconds: 1) wait.
			Smalltalk snapshot: false andQuit: true].
	(Delay forSeconds: 5) wait.
	p exitStatus == 0
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess squeakSqueak ... '.
	p _ UnixProcess squeakSqueak.
	(Delay forSeconds: 5) wait.
	OSProcess thisOSProcess sigkill: p.
	(Delay forSeconds: 1) wait.
	p exitStatus == 9
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess restartVirtualMachine ... '.
	p _ UnixProcess restartVirtualMachine.
	p pid == OSProcess thisOSProcess pid
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failure!
 s _ failures + 1].
	Transcript show: 'UnixProcess command: ''c!
 at'' inp
ut: ''this is some test data'' ... '.
	p _ (OSProcess thisOSProcess
		command: 'cat'
		input: 'this is some test data').
	(Delay forSeconds: 1) wait.
	p upToEnd = 'this is some test data'
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'UnixProcess waitForCommandOutput: ''echo sleeping...; sleep 1; echo I just slept for one second'' ... '.
	('*I just slept for one second*' match:
		(OSProcess thisOSProcess
			waitForCommandOutput: 'echo sleeping...; sleep 1; echo I just slept for one second'))
		ifTrue: [Transcript show: 'OK'; cr]
		ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1].
	Transcript show: 'Unix command pipeline with output and error returned in an array ... '.
	(Smalltalk hasClassNamed: #PipeableOSProcess)
		ifTrue:
			[a _ (((Smalltalk at: #PipeableOSProcess) command: 'echo this is a test; BOGUS') | 'cut -c11-14') outputAndError.
			(((a isKindOf: Array)
				and: ['test*' matc!
 h: (a at: 1)])
					and: ['*BOGUS*' match: (a at: 2)])
						ifTrue: [Transcript show: 'OK'; cr]
						ifFalse: [Transcript show: 'NFG'; cr. failures _ failures + 1]]
		ifFalse:
			[Transcript show: 'skipping PipeableOSProcess test (requires CommandShell)'; cr].

	Transcript show: 'UnixProcess decapitate and recapatiate five times'; cr.
	5 timesRepeat:
		[UnixProcess decapitate.
		UnixProcess recapitate].

	failures == 1
		ifTrue: [result _ 'OSProcess tests completed with ', failures printString, ' failure']
		ifFalse: [result _ 'OSProcess tests completed with ', failures printString, ' failures'].
	Transcript show: result; cr.

	^ result
! !


!StandardFileStream reorganize!
('open/close' close closed ensureOpen open open:forWrite: openReadOnly reopen)
('properties-setting' asHtml ascii binary getFileType insertLineFeeds isBinary isReadOnly readOnly readWrite setFileTypeToObject)
('access' directory directoryUrl file fullName isDirectory localName name peekFor: printOn: re!
 set size)
('read, write, position' atEnd basicNext compressFil!
 e findSt
ring: findStringFromEnd: flush next next: next:into:startingAt: next:putAll:startingAt: nextPut: nextPutAll: nextWordsInto: nextWordsPutAll: padToEndWith: peek peekLast position position: readInto:startingAt:count: readOnlyCopy setToEnd skip: truncate truncate: upTo: upToEnd verbatim:)
('primitives' primAtEnd: primClose: primCloseNoError: primFlush: primGetPosition: primOpen:writable: primRead:into:startingAt:count: primSetPosition:to: primSize: primSizeNoError: primTruncate:to: primWrite:from:startingAt:count:)
('registry' register unregister)
('finalization' actAsExecutor finalize)
('browser requests' defaultBrowserReadyWait post:target:url:ifError: post:url:ifError: primBrowserReady primURLPost:data:semaIndex: primURLPost:target:data:semaIndex: primURLRequest:semaIndex: primURLRequest:target:semaIndex: primURLRequestDestroy: primURLRequestFileHandle: primURLRequestState: requestURL:target: requestURL:target:ifError: requestURLStream: requestURLStream:ifError: waitBrowserR!
 eadyFor:ifFail:)
('dnd requests' primDropRequestFileHandle: primDropRequestFileName: requestDropStream:)
('*oSProcess-base' fileID)
!
-------------- next part --------------
'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5325] on 14 July 2003 at 9:37:30 pm'!
"Change Set:		OSProcess-sUnitV3-0-6-dtl
Date:			14 July 2003
Author:			David T. Lewis

Unit tests for OSProcess"!

TestCase subclass: #OSPipeTestCase
	instanceVariableNames: 'pipe '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OSProcess-SUnit'!

!OSPipeTestCase commentStamp: '<historical>' prior: 0!
Test operation of OSPipe in blocking and nonBlocking mode.!

TestCase subclass: #UnixProcessAccessorTestCase
	instanceVariableNames: 'accessor '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OSProcess-SUnit'!

!UnixProcessAccessorTestCase commentStamp: '<historical>' prior: 0!
Unit tests for the UnixProcessAccessor.!

TestCase subclass: #UnixProcessTestCase
	instanceVariableNames: 'thisOSProcess '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OSProcess-SUnit'!

!UnixProcessTestCase commentStamp: '<historical>' prior: 0!
Unit tests for the Unix port!
 ion of OSProcess.!


!OSPipeTestCase methodsFor: 'running' stamp: 'dtl 11/25/2001 00:33'!
runAll

	"OSPipeTestCase new runAll"

	| result suite |
	suite := TestSuite new.
	suite addTest: (OSPipeTestCase selector: #testBlocking).
	suite addTest: (OSPipeTestCase selector: #testNonBlocking).
	result _ suite run.
	self should: [result defects size == 0].
	^ result
! !

!OSPipeTestCase methodsFor: 'running' stamp: 'dtl 11/25/2001 00:14'!
setUp

		pipe _ OSPipe new
! !

!OSPipeTestCase methodsFor: 'testing' stamp: 'dtl 11/25/2001 00:30'!
testBlocking

	"(OSPipeTestCase selector: #testBlocking) run"

	| ws str |
	pipe setNonBlocking.
	self writeStuffOnThenClose: pipe.
	ws _ self readFromAndClose: pipe writingTo: (WriteStream on: String new).
	str _ (ws contents last: 16).
	self should: ['this is line 10*' match: str]
! !

!OSPipeTestCase methodsFor: 'testing' stamp: 'dtl 11/25/2001 00:29'!
testNonBlocking

	"(OSPipeTestCase selector: #testNonBlocking) run"

	| ws str |
	pipe setNo!
 nBlocking.
	self writeStuffOnThenClose: pipe.
	ws _ self readF!
 romAndCl
ose: pipe writingTo: (WriteStream on: String new).
	str _ (ws contents last: 16).
	self should: ['this is line 10*' match: str]
! !

!OSPipeTestCase methodsFor: 'private' stamp: 'dtl 11/25/2001 00:42'!
readFromAndClose: aPipe writingTo: aStream

	| s |
	[aPipe atEnd] whileFalse:
		[s _ aPipe next: 10000.
		aStream nextPutAll: s asString.
		(Delay forMilliseconds: 100) wait].
	(aPipe respondsTo: #reader) ifTrue: [aPipe reader close].
	^ aStream
! !

!OSPipeTestCase methodsFor: 'private' stamp: 'dtl 11/24/2001 23:58'!
writeStuffOnThenClose: aPipe

	^ [(1 to: 10) do:
		[:i |
		aPipe nextPutAll: 'this is line ', i printString; cr.
		(Delay forMilliseconds: 250) wait].
	(aPipe respondsTo: #writer)
		ifTrue: [aPipe writer close]
		ifFalse: [aPipe close]]
		forkAt: Processor userBackgroundPriority! !


!UnixProcessAccessorTestCase methodsFor: 'running' stamp: 'dtl 3/1/2002 18:02'!
runAll

	"UnixProcessAccessorTestCase new runAll"

	| result suite |
	suite := TestSuite new.
	suite a!
 ddTest: (UnixProcessAccessorTestCase selector: #testSessionIdentifier).
	suite addTest: (UnixProcessAccessorTestCase selector: #testCanAccessSystem).
	suite addTest: (UnixProcessAccessorTestCase selector: #testMakePipeHandles).
	suite addTest: (UnixProcessAccessorTestCase selector: #testUnixFileNumber).
	suite addTest: (UnixProcessAccessorTestCase selector: #testFileProtectionMask).
	suite addTest: (UnixProcessAccessorTestCase selector: #testFileStat).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsExecutable).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsExecutableForUserInGroup).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsReadable).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsReadableForUserInGroup).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsWritable).
	suite addTest: (UnixProcessAccessorTestCase selector: #testIsWritableForUserInGroup).

	suite addTest: (UnixProcessAccessorTestCase s!
 elector: #runExternalProcessAccess).
	suite addTest: (UnixProc!
 essAcces
sorTestCase selector: #runForkAndExec).

	result _ suite run.
	self should: [result defects size == 0].
	^ result
! !

!UnixProcessAccessorTestCase methodsFor: 'running' stamp: 'dtl 10/14/2001 12:18'!
runExternalProcessAccess

	"UnixProcessAccessorTestCase new runExternalProcessAccess"

	| result suite |
	suite := TestSuite new.
	suite addTest: (UnixProcessAccessorTestCase selector: #testCanAccessSystem).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetCurrentWorkingDirectory).
	suite addTest: (UnixProcessAccessorTestCase selector: #testChDir).
	suite addTest: (UnixProcessAccessorTestCase selector: #testEnvironmentAt).
	suite addTest: (UnixProcessAccessorTestCase selector: #testEnvironmentAtPut1).
	suite addTest: (UnixProcessAccessorTestCase selector: #testEnvironmentAtPut2).
	suite addTest: (UnixProcessAccessorTestCase selector: #testEnvironmentAtPut).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimUnsetEnv).
	suite addTest: (UnixProcessA!
 ccessorTestCase selector: #testGetStdInHandle).
	suite addTest: (UnixProcessAccessorTestCase selector: #testGetStdOutHandle).
	suite addTest: (UnixProcessAccessorTestCase selector: #testGetStdErrHandle).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimArgumentAt).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimErrorMessageAt).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetPid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetGid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetEGid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetPid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetPPid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetUid).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetSession).
	suite addTest: (UnixProcessAccessorTestCase selector: #testRealpath).
	suite addTest: (UnixProcessAccessorTe!
 stCase selector: #testRenameTo).

	result _ suite run.
	self s!
 hould: [
result defects size == 0].
	^ result
! !

!UnixProcessAccessorTestCase methodsFor: 'running' stamp: 'dtl 10/6/2001 11:37'!
runForkAndExec
	"Most of this must be tested from class UnixProcess"

	"UnixProcessAccessorTestCase new runForkAndExec"

	| result suite |
	suite := TestSuite new.
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimGetChildExitStatus).
	suite addTest: (UnixProcessAccessorTestCase selector: #testPrimForkAndExec).
	result _ suite run.
	self should: [result defects size == 0].
	^ result
! !

!UnixProcessAccessorTestCase methodsFor: 'running' stamp: 'dtl 10/6/2001 08:29'!
setUp

	accessor _ ThisOSProcess accessor! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 08:36'!
testCanAccessSystem

	"(UnixProcessAccessorTestCase selector: #testCanAccessSystem) run"

	self assert: accessor canAccessSystem! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 11:59'!
testFileProtectionMask

	"(UnixProcessA!
 ccessorTestCase selector: #testFileProtectionMask) run"

	| mask |
	mask _ accessor fileProtectionMask: '/bin/rm'.
	self assert: (mask isKindOf: Array).
	self assert: (mask size == 4)
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 12:06'!
testFileStat

	"(UnixProcessAccessorTestCase selector: #testFileStat) run"

	| stat |
	stat _ accessor fileStat: '/bin/rm'.
	self assert: (stat isKindOf: Array).
	self assert: (stat size == 3).
	self assert: ((stat at: 1) isKindOf: Integer).
	self assert: ((stat at: 2) isKindOf: Integer).
	self assert: ((stat at: 3) isKindOf: Array).
	self assert: ((stat at: 3) size == 4)
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 12:08'!
testIsExecutable

	"(UnixProcessAccessorTestCase selector: #testIsExecutable) run"

	self should: [accessor isExecutable: '/bin/sh'].
	self shouldnt: [accessor isExecutable: '/etc/hosts']
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 1!
 0/20/2001 11:47'!
testIsExecutableForUserInGroup

	"(UnixProce!
 ssAccess
orTestCase selector: #testIsExecutableForUserInGroup) run"

	OSProcess waitForCommand: 'touch /tmp/delete.me'.
	OSProcess waitForCommand: 'chmod 550 /tmp/delete.me'.
	self should: [accessor isExecutable: '/bin/sh'
					forUser: accessor primGetUid
					inGroup: accessor primGetGid].
	self shouldnt: [accessor isExecutable: '/etc/hosts'
					forUser: accessor primGetUid
					inGroup: accessor primGetGid].
	self should: [accessor isExecutable: '/tmp/delete.me'
					forUser: accessor primGetUid
					inGroup: 99999].
	self should: [accessor isExecutable: '/tmp/delete.me'
					forUser: 99999
					inGroup: accessor primGetGid].
	self shouldnt: [accessor isExecutable: '/tmp/delete.me'
					forUser: 99999
					inGroup: 99999].
	FileDirectory default deleteFileNamed: '/tmp/delete.me' ifAbsent: []
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/20/2001 11:39'!
testIsReadable

	"(UnixProcessAccessorTestCase selector: #testIsReadable) run"

	self should: [accessor !
 isReadable: '/bin/sh'].
	OSProcess waitForCommand: 'touch /tmp/delete.me'.
	OSProcess waitForCommand: 'chmod 440 /tmp/delete.me'.
	(Delay forMilliseconds: 200) wait.
	self should: [accessor isReadable: '/tmp/delete.me'].
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/20/2001 11:47'!
testIsReadableForUserInGroup

	"(UnixProcessAccessorTestCase selector: #testIsReadableForUserInGroup) run"

	OSProcess waitForCommand: 'touch /tmp/delete.me'.
	OSProcess waitForCommand: 'chmod 550 /tmp/delete.me'.
	self should: [accessor isReadable: '/bin/sh'
					forUser: accessor primGetUid
					inGroup: accessor primGetGid].
	self should: [accessor isReadable: '/tmp/delete.me'
					forUser: accessor primGetUid
					inGroup: 99999].
	self should: [accessor isReadable: '/tmp/delete.me'
					forUser: 99999
					inGroup: accessor primGetGid].
	self shouldnt: [accessor isReadable: '/tmp/delete.me'
					forUser: 99999
					inGroup: 99999].
	FileDirectory default deleteFileNa!
 med: '/tmp/delete.me' ifAbsent: []
! !

!UnixProcessAccessorTe!
 stCase m
ethodsFor: 'testing' stamp: 'dtl 10/20/2001 11:38'!
testIsWritable

	"(UnixProcessAccessorTestCase selector: #testIsWritable) run"

	self shouldnt: [accessor isWritable: '/bin/sh'].
	OSProcess waitForCommand: 'touch /tmp/delete.me'.
	OSProcess waitForCommand: 'chmod 770 /tmp/delete.me'.
	(Delay forMilliseconds: 200) wait.
	self should: [accessor isWritable: '/tmp/delete.me'].
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/20/2001 11:48'!
testIsWritableForUserInGroup

	"(UnixProcessAccessorTestCase selector: #testIsWritableForUserInGroup) run"

	OSProcess waitForCommand: 'touch /tmp/delete.me'.
	OSProcess waitForCommand: 'chmod 770 /tmp/delete.me'.
	self shouldnt: [accessor isWritable: '/bin/sh'
					forUser: accessor primGetUid
					inGroup: accessor primGetGid].
	self should: [accessor isWritable: '/tmp/delete.me'
					forUser: accessor primGetUid
					inGroup: 99999].
	self should: [accessor isWritable: '/tmp/delete.me'
					forUser: 99999
					inGr!
 oup: accessor primGetGid].
	self shouldnt: [accessor isWritable: '/tmp/delete.me'
					forUser: 99999
					inGroup: 99999].
	FileDirectory default deleteFileNamed: '/tmp/delete.me' ifAbsent: []
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 11:48'!
testMakePipeHandles

	"(UnixProcessAccessorTestCase selector: #testMakePipeHandles) run"

	| p |
	p _ OSPipe new.
	self assert: p reader closed not.
	self assert: p writer closed not.
	p close! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 3/1/2002 18:01'!
testSessionIdentifier
	"This is an indirect way to make sure that the primitive for obtaining the session ID does
	not get out of kilter with respect to the method for obtaining session ID from an existing
	open file. The dangerous failure mode is if the SQFile data stucture format changes and
	OSProcess does not get updated to reflect the change."

	"(UnixProcessAccessorTestCase selector: #testSessionIdentifier) run"

	self sh!
 ould: [accessor getSessionIdentifierFromSourcesFile = accessor!
  getSess
ionIdentifier]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing' stamp: 'dtl 10/6/2001 11:55'!
testUnixFileNumber

	"(UnixProcessAccessorTestCase selector: #testUnixFileNumber) run"

	| num |
	num _ accessor unixFileNumber: OSProcess thisOSProcess stdOut ioHandle.
	self assert: num ==1! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 08:50'!
testChDir

	"(UnixProcessAccessorTestCase selector: #testChDir) run"

	| cwd new |
	cwd _ accessor primGetCurrentWorkingDirectory.
	new _ '/tmp'.
	accessor chDir: new.
	self should: [new = accessor primGetCurrentWorkingDirectory].
	accessor chDir: cwd.
	self should: [cwd = accessor primGetCurrentWorkingDirectory].
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 08:53'!
testEnvironmentAt

	"(UnixProcessAccessorTestCase selector: #testEnvironmentAt) run"

	| path |
	path _ accessor environmentAt: 'PATH'.
	self should: [path n!
 otNil and: [path isEmpty not]]! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/7/2001 14:08'!
testEnvironmentAtPut

	"(UnixProcessAccessorTestCase selector: #testEnvironmentAtPut) run"

	| oldPath newPath resetPath s |
	oldPath _ accessor environmentAt: 'PATH'.
	newPath _ 'this is a test string'.
	accessor environmentAt: 'PATH' put: newPath.
	resetPath _ accessor environmentAt: 'PATH'.
	self should: [newPath = resetPath].
	accessor environmentAt: 'PATH' put: oldPath.
	resetPath _ accessor environmentAt: 'PATH'.
	self should: [oldPath = resetPath].
	s _ WriteStream on: ''.
	10000 timesRepeat: [s nextPutAll: 'Do something to provoke garbage collection'].
	resetPath _ accessor environmentAt: 'PATH'.
	self should: [oldPath = resetPath].


! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/7/2001 11:47'!
testEnvironmentAtPut1

	"(UnixProcessAccessorTestCase selector: #testEnvironmentAtP!
 ut1) run"

	| oldVal newVal resetVal |
	oldVal _ accessor envi!
 ronmentA
t: 'AAAA'.
	newVal _ 'this is a test string'.
	accessor environmentAt: 'AAAA' put: newVal.
	resetVal _ accessor environmentAt: 'AAAA'.
	self should: [resetVal notNil and: [resetVal isEmpty not]].
	self should: [newVal = resetVal].
	accessor environmentAt: 'AAAA' put: oldVal.
	self should: [oldVal = (accessor environmentAt: 'AAAA')]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/7/2001 12:14'!
testEnvironmentAtPut2
	"This looks for a bug in which the enviroment is successfully, but later gets
	invalidated by memory moves or reallocation."

	"(UnixProcessAccessorTestCase selector: #testEnvironmentAtPut2) run"

	| oldVal newVal resetVal count ws goodResults notFound totallyBogus |
	oldVal _ accessor environmentAt: 'AAAA'.
	newVal _ 'this is a test string'.
	accessor environmentAt: 'AAAA' put: newVal.
	resetVal _ accessor environmentAt: 'AAAA'.
	self should: [resetVal notNil and: [resetVal isEmpty not]].
	self should: [newVal = r!
 esetVal].

	count _ 50000.
	ws _ WriteStream on: Array new.
	count timesRepeat: [ws nextPut: (accessor environmentAt: 'AAAA')].
	goodResults _ ws contents select: [:e | e = newVal].
	notFound _ ws contents select: [:e | e isNil].
	totallyBogus _ ws contents select: [:e | e notNil and: [e ~= newVal]].

	"Uncomment the following to see when the problem is happening"
	"(Array with: goodResults with: notFound with: totallyBogus) inspect."

	self should: [goodResults size == count].
	self should: [notFound isEmpty].
	self should: [totallyBogus isEmpty].

	accessor environmentAt: 'AAAA' put: oldVal.
	self should: [oldVal = (accessor environmentAt: 'AAAA')]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:36'!
testGetStdErrHandle

	"(UnixProcessAccessorTestCase selector: #testGetStdErrHandle) run"

	| handle |
	handle _ accessor primGetStdErrHandle.
	self assert: handle notNil
! !

!UnixProcessAccessorTestCase methodsFor: '!
 testing - external process access' stamp: 'dtl 10/6/2001 09:36!
 '!
testG
etStdInHandle

	"(UnixProcessAccessorTestCase selector: #testGetStdInHandle) run"

	| handle |
	handle _ accessor primGetStdInHandle.
	self assert: handle notNil
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:36'!
testGetStdOutHandle

	"(UnixProcessAccessorTestCase selector: #testGetStdOutHandle) run"

	| handle |
	handle _ accessor primGetStdOutHandle.
	self assert: handle notNil
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:42'!
testPrimArgumentAt

	"(UnixProcessAccessorTestCase selector: #testPrimArgumentAt) run"

	| progName |
	progName _ accessor primArgumentAt: 1.
	self should: [progName notNil and: [progName isEmpty not]]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:45'!
testPrimErrorMessageAt

	"(UnixProcessAccessorTestCase selector: #testPrimErrorMessageAt) run"

	| msg |
	msg _ accesso!
 r primErrorMessageAt: 1.
	self should: [msg notNil and: [msg isEmpty not]].
	msg _ accessor primErrorMessageAt: 0.
	self should: [msg notNil and: [msg isEmpty not]]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 08:45'!
testPrimGetCurrentWorkingDirectory

	"(UnixProcessAccessorTestCase selector: #testPrimGetCurrentWorkingDirectory) run"

	| cwd |
	cwd _ accessor primGetCurrentWorkingDirectory.
	self should: [cwd notNil and: [cwd isEmpty not]]! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:49'!
testPrimGetEGid

	"(UnixProcessAccessorTestCase selector: #testPrimGetEGid) run"

	| id |
	id _ accessor primGetEGid.
	self should: [id isKindOf: Integer]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:49'!
testPrimGetEUid

	"(UnixProcessAccessorTestCase selector: #testPrimGetEUid) run"

	| id |
	id _ accessor p!
 rimGetEUid.
	self should: [id isKindOf: Integer]
! !

!UnixPro!
 cessAcce
ssorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:50'!
testPrimGetGid

	"(UnixProcessAccessorTestCase selector: #testPrimGetGid) run"

	| id |
	id _ accessor primGetGid.
	self should: [id isKindOf: Integer]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:50'!
testPrimGetPPid

	"(UnixProcessAccessorTestCase selector: #testPrimGetPPid) run"

	| id |
	id _ accessor primGetPPid.
	self should: [id isKindOf: Integer]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:50'!
testPrimGetPid

	"(UnixProcessAccessorTestCase selector: #testPrimGetPid) run"

	| id |
	id _ accessor primGetPid.
	self should: [id isKindOf: Integer]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 7/13/2003 14:42'!
testPrimGetSession
	"This test is executed only if OSProcessPlugin>>concreteClass in this image
	contai!
 ns a #primitiveGetSession method. The assumption is that the plugin
	which is currently being used by the VM should have been generated from
	the plugin class in this image. It is legitimate to use a variant of the plugin
	which does not support the primitive, so we bypass this test if that is our
	configuration."

	"(UnixProcessAccessorTestCase selector: #testPrimGetSession) run"

	| id |
	((Smalltalk at: #OSProcessPlugin) concreteClass includesSelector: #primitiveGetSession)
		ifTrue:
			[id _ accessor primGetSession.
			self should: [id isKindOf: ByteArray]]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 09:50'!
testPrimGetUid

	"(UnixProcessAccessorTestCase selector: #testPrimGetUid) run"

	| id |
	id _ accessor primGetUid.
	self should: [id isKindOf: Integer]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/7/2001 14:07'!
testPrimUnsetEnv

	"(UnixProcessAccessorTest!
 Case selector: #testPrimUnsetEnv) run"

	| oldVal newVal reset!
 Val |
	o
ldVal _ accessor environmentAt: 'AAAA'.
	newVal _ 'this is a test string'.
	accessor environmentAt: 'AAAA' put: newVal.
	resetVal _ accessor environmentAt: 'AAAA'.
	self should: [resetVal notNil and: [resetVal isEmpty not]].
	self should: [newVal = resetVal].

	accessor primUnsetEnv: 'AAAA', (Character value: 0) asString.
	resetVal _ accessor environmentAt: 'AAAA'.
	self should: [resetVal isNil].

	accessor environmentAt: 'AAAA' put: oldVal.
	self should: [oldVal = (accessor environmentAt: 'AAAA')]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 10:03'!
testRealpath

	"(UnixProcessAccessorTestCase selector: #testRealpath) run"

	| p |
	p _ accessor realpath: '/usr/bin'.
	self should: [p notNil and: [p isEmpty not]].
	p _ accessor realpath: '/bogus/path/name'.
	self should: [p isNil]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - external process access' stamp: 'dtl 10/6/2001 10:33'!
testRenameTo

	"(UnixProces!
 sAccessorTestCase selector: #testRenameTo) run"

	| name1 name2 testString fs str |
	name1 _ '/tmp/delete.me'.
	name2 _ '/tmp/delete.me.too'.
	testString _ 'this is a test'.
	FileDirectory default deleteFileNamed: name1 ifAbsent: [].
	FileDirectory default deleteFileNamed: name2 ifAbsent: [].
	fs _ FileStream fileNamed: name1.
	fs nextPutAll: testString.
	fs close.
	accessor rename: name1 to: name2.
	fs _ FileStream fileNamed: name2.
	str _ fs upToEnd.
	fs close.
	FileDirectory default deleteFileNamed: name1 ifAbsent: [].
	FileDirectory default deleteFileNamed: name2 ifAbsent: [].
	self should: [str = testString]
! !

!UnixProcessAccessorTestCase methodsFor: 'testing - fork and exec' stamp: 'dtl 10/6/2001 11:37'!
testPrimForkAndExec
	"These methods can only be tested properly from UnixProcess, which knows how
	to set up the parameters on the stack."

	"(UnixProcessAccessorTestCase selector: #testPrimForkAndExec) run"

	| p |
	p _ UnixProcess command: 'ls /bin'.
	(Delay forM!
 illiseconds: 500) wait.
	self should: [p isComplete].
	self sh!
 ould: [p
 exitStatus == 0]

! !

!UnixProcessAccessorTestCase methodsFor: 'testing - fork and exec' stamp: 'dtl 10/6/2001 10:44'!
testPrimGetChildExitStatus
	"Cannot really test this here, because it needs to be wired into the interrupt
	handler. Just make sure it returns nil when there is nothing to do."

	"(UnixProcessAccessorTestCase selector: #testPrimGetChildExitStatus) run"

	| stat |
	stat _ accessor primGetChildExitStatus: -1.
	self should: [stat isNil].
	stat _ accessor primGetChildExitStatus: 1.
	self should: [stat isNil]
! !


!UnixProcessTestCase methodsFor: 'running' stamp: 'dtl 3/10/2002 10:52'!
runAll
	"If you get intermittent failures, try doing a garbage collect. Some of these
	tests can fail intermittently on the open file handle count checks"

	"UnixProcessTestCase new runAll"

	| result suite |
	Smalltalk garbageCollect.
	suite := TestSuite new.
	suite addTest: (UnixProcessTestCase selector: #testClassForkSqueak).
	suite addTest: (UnixProcessTestCase selector: #te!
 stClassForkSqueakAndDo).
	suite addTest: (UnixProcessTestCase selector: #testClassForkSqueakAndDoThenQuit).
	suite addTest: (UnixProcessTestCase selector: #testClassForkHeadlessSqueakAndDo).
	suite addTest: (UnixProcessTestCase selector: #testClassForkHeadlessSqueakAndDoThenQuit).
	suite addTest: (UnixProcessTestCase selector: #testForkSqueak).
	suite addTest: (UnixProcessTestCase selector: #testForkSqueakAndDo).
	suite addTest: (UnixProcessTestCase selector: #testForkSqueakAndDoThenQuit).
	suite addTest: (UnixProcessTestCase selector: #testForkHeadlessSqueakAndDo).
	suite addTest: (UnixProcessTestCase selector: #testForkHeadlessSqueakAndDoThenQuit).
	suite addTest: (UnixProcessTestCase selector: #testHeadlessChild).
	suite addTest: (UnixProcessTestCase selector: #testSpawnTenHeadlessChildren).
	suite addTest: (UnixProcessTestCase selector: #testEightLeafSqueakTree).
	suite addTest: (UnixProcessTestCase selector: #testCatAFile).
	suite addTest: (UnixProcessTestCase selector!
 : #testCatFromFileToFiles).
	suite addTest: (UnixProcessTestCa!
 se selec
tor: #testRunCommand).
	suite addTest: (UnixProcessTestCase selector: #testPipe).
	suite addTest: (UnixProcessTestCase selector: #testPipeLine).

	result _ suite run.
	self should: [result defects size == 0].
	^ result
! !

!UnixProcessTestCase methodsFor: 'running' stamp: 'dtl 10/8/2001 06:01'!
setUp

	thisOSProcess _ OSProcess thisOSProcess
! !

!UnixProcessTestCase methodsFor: 'testing - class side methods' stamp: 'dtl 10/12/2001 08:27'!
testClassForkHeadlessSqueakAndDo

	"(UnixProcessTestCase selector: #testClassForkHeadlessSqueakAndDo) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess forkHeadlessSqueakAndDo:
			[(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0]!
 .
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - class side methods' stamp: 'dtl 10/12/2001 08:28'!
testClassForkHeadlessSqueakAndDoThenQuit

	"(UnixProcessTestCase selector: #testClassForkHeadlessSqueakAndDoThenQuit) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess forkHeadlessSqueakAndDoThenQuit:
			[(Delay forMilliseconds: 100) wait].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - class side methods' stamp: 'dtl 10/12/2001 08:28'!
testClassForkSqueak

	"(UnixProcessTestCase selector: #testClassForkSqueak) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p!
  _ UnixProcess forkSqueak.
	self assert: p notNil.
	(p == this!
 OSProces
s)
		ifTrue:
			["Child Squeak"
			p inspect.
			(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true]
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - class side methods' stamp: 'dtl 10/12/2001 08:28'!
testClassForkSqueakAndDo

	"(UnixProcessTestCase selector: #testClassForkSqueakAndDo) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess forkSqueakAndDo:
			[(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should:!
  [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - class side methods' stamp: 'dtl 10/12/2001 08:29'!
testClassForkSqueakAndDoThenQuit

	"(UnixProcessTestCase selector: #testClassForkSqueakAndDoThenQuit) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess forkSqueakAndDoThenQuit:
			[(Delay forMilliseconds: 100) wait].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:54'!
testCatAFile

	"(UnixProcessTestCase selector: #testCatAFile) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess catAFil!
 e.
	self assert: p notNil.
	self should: [p isRunning].
	[p is!
 Running]
 whileTrue: [(Delay forMilliseconds: 100) wait].
	self should: [p isComplete].
	self should: [p exitStatus == 0].
	self should: [p initialStdIn closed]. "Used a file for input, should be closed"
	self shouldnt: [p initialStdOut closed]. "Shared stdout with the VM, should be open"
	self shouldnt: [p initialStdErr closed]. "Shared stderr with the VM, should be open"
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:30'!
testCatFromFileToFiles

	"(UnixProcessTestCase selector: #testCatFromFileToFiles) run"

	| p f openFileCount |
	openFileCount _ self numberOfOpenFiles.
	FileDirectory default deleteFileNamed: '/tmp/deleteMe.out' ifAbsent: [].
	FileDirectory default deleteFileNamed: '/tmp/deleteMe.err' ifAbsent: [].
	p _ UnixProcess catFromFileToFiles.
	self assert: p notNil.
	self should: [p isRunning].
	[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
	self should: [p is!
 Complete].
	self should: [p exitStatus == 0].
	self should: [p initialStdIn closed].
	self should: [p initialStdOut closed].
	self should: [p initialStdErr closed].
	f _ FileStream oldFileNamed: '/tmp/deleteMe.out'.
	self shouldnt: [f upToEnd isEmpty].
	f close.
	f _ FileStream oldFileNamed: '/tmp/deleteMe.err'.
	self should: [f upToEnd isEmpty].
	f close.
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:31'!
testEightLeafSqueakTree

	"(UnixProcessTestCase selector: #testEightLeafSqueakTree) run"

	| a openFileCount |
	openFileCount _ self numberOfOpenFiles.
	a _ UnixProcess eightLeafSqueakTree.
	self assert: (a isKindOf: Array).
	self assert: a size == 3.
	(a includes: 0)
		ifTrue:
			[Smalltalk quitPrimitive].
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:31'!
testHeadlessChild

	!
 "(UnixProcessTestCase selector: #testHeadlessChild) run"

	| p!
  openFil
eCount |
	openFileCount _ self numberOfOpenFiles.
	p _ UnixProcess headlessChild.
	[p isComplete] whileFalse: [(Delay forMilliseconds: 100) wait].
	self assert: p isComplete.
	self assert: p exitStatus == 0.
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:32'!
testPipe

	"(UnixProcessTestCase selector: #testPipe) run"

	| openFileCount |
	openFileCount _ self numberOfOpenFiles.
	self should: [UnixProcess testPipe = 'this is some text to write into the pipe'].
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:32'!
testPipeLine

	"(UnixProcessTestCase selector: #testPipeLine) run"

	| openFileCount |
	openFileCount _ self numberOfOpenFiles.
	self should: ['This is the text to write*' match: UnixProcess testPipeLine].
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessT!
 estCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:50'!
testRunCommand

	"(UnixProcessTestCase selector: #testRunCommand) run"

	| p f openFileCount |
	openFileCount _ self numberOfOpenFiles.
	FileDirectory default deleteFileNamed: '/tmp/deleteMe.out' ifAbsent: [].
	FileDirectory default deleteFileNamed: '/tmp/deleteMe.err' ifAbsent: [].
	p _ UnixProcess testRunCommand.
	self assert: p notNil.
	self should: [p isRunning].
	[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
	self should: [p isComplete].
	self should: [p exitStatus > 0].	"Forced an error exit status"
	"stdin was shared with the Squeak VM, so it should not have been closed."
	self shouldnt: [p initialStdIn closed].
	"but the output and error streams should have been closed."
	self should: [p initialStdOut closed].
	self should: [p initialStdErr closed].
	f _ FileStream oldFileNamed: '/tmp/deleteMe.out'.
	self shouldnt: [f upToEnd isEmpty].
	f close.
	f _ FileStream oldFileNamed!
 : '/tmp/deleteMe.err'.
	self shouldnt: [f upToEnd isEmpty].
	f!
  close.
	self assert: self numberOfOpenFiles == openFileCount


! !

!UnixProcessTestCase methodsFor: 'testing - class examples' stamp: 'dtl 10/12/2001 08:34'!
testSpawnTenHeadlessChildren

	"(UnixProcessTestCase selector: #testSpawnTenHeadlessChildren) run"

	| a openFileCount |
	openFileCount _ self numberOfOpenFiles.
	a _ UnixProcess spawnTenHeadlessChildren.
	[(a detect: [:p | p isComplete not] ifNone: []) notNil]
		whileTrue: [(Delay forMilliseconds: 100) wait].
	self should: [(a select: [:p | p isComplete not]) isEmpty].
	self assert: self numberOfOpenFiles == openFileCount
! !

!UnixProcessTestCase methodsFor: 'testing - child process creation' stamp: 'dtl 10/12/2001 08:35'!
testForkHeadlessSqueakAndDo

	"(UnixProcessTestCase selector: #testForkHeadlessSqueakAndDo) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ thisOSProcess forkHeadlessSqueakAndDo:
			[(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true].
	self assert: p no!
 tNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - child process creation' stamp: 'dtl 10/12/2001 08:35'!
testForkHeadlessSqueakAndDoThenQuit

	"(UnixProcessTestCase selector: #testForkHeadlessSqueakAndDoThenQuit) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ thisOSProcess forkHeadlessSqueakAndDoThenQuit:
			[(Delay forMilliseconds: 100) wait].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTes!
 tCase methodsFor: 'testing - child process creation' stamp: 'd!
 tl 10/12
/2001 08:35'!
testForkSqueak

	"(UnixProcessTestCase selector: #testForkSqueak) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ thisOSProcess forkSqueak.
	self assert: p notNil.
	(p == thisOSProcess)
		ifTrue:
			["Child Squeak"
			p inspect.
			(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true]
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - child process creation' stamp: 'dtl 10/12/2001 08:36'!
testForkSqueakAndDo

	"(UnixProcessTestCase selector: #testForkSqueakAndDo) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ thisOSProcess forkSqueakAndDo:
			[(Delay forMilliseconds: 100) wait.
			Smalltalk snapshot: false andQuit: true].
	self asse!
 rt: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor: 'testing - child process creation' stamp: 'dtl 10/12/2001 08:36'!
testForkSqueakAndDoThenQuit

	"(UnixProcessTestCase selector: #testForkSqueakAndDoThenQuit) run"

	| p openFileCount |
	openFileCount _ self numberOfOpenFiles.
	p _ thisOSProcess forkSqueakAndDoThenQuit:
			[(Delay forMilliseconds: 100) wait].
	self assert: p notNil.
	(p == thisOSProcess)
		ifFalse:
			["Parent Squeak process"
			self should: [p isRunning].
			[p isRunning] whileTrue: [(Delay forMilliseconds: 100) wait].
			self should: [p isComplete].
			self should: [p exitStatus == 0].
			self assert: self numberOfOpenFiles == openFileCount]
! !

!UnixProcessTestCase methodsFor!
 : 'private' stamp: 'dtl 10/12/2001 07:39'!
numberOfOpenFiles
	!
 "Answer 
the number of files currently open for this OS process. This works
	only on a system with a /proc filesystem and file descriptors located in a
	directory called /proc/<pid>/fd. On other systems, just answer 0."

	"UnixProcessTestCase new numberOfOpenFiles"

	^ (FileDirectory on: '/proc/' , OSProcess thisOSProcess pid printString, '/fd') entries size! !


!UnixProcessTestCase reorganize!
('running' runAll setUp)
('testing - class side methods' testClassForkHeadlessSqueakAndDo testClassForkHeadlessSqueakAndDoThenQuit testClassForkSqueak testClassForkSqueakAndDo testClassForkSqueakAndDoThenQuit)
('testing - class examples' testCatAFile testCatFromFileToFiles testEightLeafSqueakTree testHeadlessChild testPipe testPipeLine testRunCommand testSpawnTenHeadlessChildren)
('testing - child process creation' testForkHeadlessSqueakAndDo testForkHeadlessSqueakAndDoThenQuit testForkSqueak testForkSqueakAndDo testForkSqueakAndDoThenQuit)
('private' numberOfOpenFiles)
!


More information about the Squeak-dev mailing list