From 369d368edd248500dbd5a9ea8c12dc37f1ad12c5 Mon Sep 17 00:00:00 2001 From: Hernan Morales Date: Sun, 22 Mar 2026 14:59:20 -0300 Subject: [PATCH] Add BioGtUnixSubprocess and tests --- .../BioGtUnixSubprocessTest.class.st | 88 +++++++++++++++++++ .../BioOSSubProcessExecutorTest.class.st | 88 +++++++++++++++++++ .../BioTools/BioAbstractAdapter.class.st | 51 +++++++++-- .../BioTools/BioGtUnixSubprocess.class.st | 87 ++++++++++++++++++ 4 files changed, 308 insertions(+), 6 deletions(-) create mode 100644 repository/BioTools-Tests/BioGtUnixSubprocessTest.class.st create mode 100644 repository/BioTools-Tests/BioOSSubProcessExecutorTest.class.st create mode 100644 repository/BioTools/BioGtUnixSubprocess.class.st diff --git a/repository/BioTools-Tests/BioGtUnixSubprocessTest.class.st b/repository/BioTools-Tests/BioGtUnixSubprocessTest.class.st new file mode 100644 index 00000000..6768f5f4 --- /dev/null +++ b/repository/BioTools-Tests/BioGtUnixSubprocessTest.class.st @@ -0,0 +1,88 @@ +" +Tests for BioGtUnixSubprocess execution API compatibility. +" +Class { + #name : 'BioGtUnixSubprocessTest', + #superclass : 'BioAbstractTest', + #category : 'BioTools-Tests-Adapters', + #package : 'BioTools-Tests', + #tag : 'Adapters' +} + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandChained [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo bio&&echo smalltalk"' ] + ifFalse: [ 'sh -c ''echo bio; echo smalltalk''' ]. + output := BioGtUnixSubprocess executeCommand: command. + self assert: (output includesSubstring: 'bio'). + self assert: (output includesSubstring: 'smalltalk') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandEcho [ + | output | + + output := BioGtUnixSubprocess executeCommand: 'echo biosmalltalk'. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandFailureReturnsErrorOutput [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "nonexistent_command_12345"' ] + ifFalse: [ 'sh -c ''nonexistent_command_12345''' ]. + output := BioGtUnixSubprocess executeCommand: command. + self deny: output isEmpty +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandParameter [ + | output | + + output := BioGtUnixSubprocess + executeCommand: 'echo' + parameter: 'biosmalltalk'. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandPipeline [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo biosmalltalk | findstr /c:biosmalltalk"' ] + ifFalse: [ 'sh -c ''echo biosmalltalk | grep biosmalltalk''' ]. + output := BioGtUnixSubprocess executeCommand: command. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandQuotedParameter [ + | output | + + output := BioGtUnixSubprocess + executeCommand: 'echo' + parameter: '"bio smalltalk"'. + self assert: (output includesSubstring: 'bio smalltalk') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testExecuteCommandStderrOutput [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo errormsg 1>&2 & exit /b 1"' ] + ifFalse: [ 'sh -c ''echo errormsg 1>&2; exit 1''' ]. + output := BioGtUnixSubprocess executeCommand: command. + self assert: (output includesSubstring: 'errormsg') +] + +{ #category : 'tests' } +BioGtUnixSubprocessTest >> testProviderClass [ + self assert: BioGtUnixSubprocess providerClass equals: #GtUnixSubprocess +] diff --git a/repository/BioTools-Tests/BioOSSubProcessExecutorTest.class.st b/repository/BioTools-Tests/BioOSSubProcessExecutorTest.class.st new file mode 100644 index 00000000..fc2ca68e --- /dev/null +++ b/repository/BioTools-Tests/BioOSSubProcessExecutorTest.class.st @@ -0,0 +1,88 @@ +" +Tests for BioOSSubProcessExecutor execution behavior. +" +Class { + #name : 'BioOSSubProcessExecutorTest', + #superclass : 'BioAbstractTest', + #category : 'BioTools-Tests-Adapters', + #package : 'BioTools-Tests', + #tag : 'Adapters' +} + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandChained [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo bio&&echo smalltalk"' ] + ifFalse: [ 'sh -c ''echo bio; echo smalltalk''' ]. + output := BioOSSubProcessExecutor executeCommand: command. + self assert: (output includesSubstring: 'bio'). + self assert: (output includesSubstring: 'smalltalk') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandEcho [ + | output | + + output := BioOSSubProcessExecutor executeCommand: 'echo biosmalltalk'. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandFailureReturnsErrorOutput [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "nonexistent_command_12345"' ] + ifFalse: [ 'sh -c ''nonexistent_command_12345''' ]. + output := BioOSSubProcessExecutor executeCommand: command. + self deny: output isEmpty +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandParameter [ + | output | + + output := BioOSSubProcessExecutor + executeCommand: 'echo' + parameter: 'biosmalltalk'. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandPipeline [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo biosmalltalk | findstr /c:biosmalltalk"' ] + ifFalse: [ 'sh -c ''echo biosmalltalk | grep biosmalltalk''' ]. + output := BioOSSubProcessExecutor executeCommand: command. + self assert: (output includesSubstring: 'biosmalltalk') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandQuotedParameter [ + | output | + + output := BioOSSubProcessExecutor + executeCommand: 'echo' + parameter: '"bio smalltalk"'. + self assert: (output includesSubstring: 'bio smalltalk') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testExecuteCommandStderrOutput [ + | command output | + + command := Smalltalk os isWindows + ifTrue: [ 'cmd /c "echo errormsg 1>&2 & exit /b 1"' ] + ifFalse: [ 'sh -c ''echo errormsg 1>&2; exit 1''' ]. + output := BioOSSubProcessExecutor executeCommand: command. + self assert: (output includesSubstring: 'errormsg') +] + +{ #category : 'tests' } +BioOSSubProcessExecutorTest >> testProviderClass [ + self assert: BioOSSubProcessExecutor providerClass equals: #OSSUnixSubprocess +] diff --git a/repository/BioTools/BioAbstractAdapter.class.st b/repository/BioTools/BioAbstractAdapter.class.st index acdcfb55..abd70f37 100644 --- a/repository/BioTools/BioAbstractAdapter.class.st +++ b/repository/BioTools/BioAbstractAdapter.class.st @@ -42,13 +42,21 @@ BioAbstractAdapter class >> adapter [ ^ self adapterClass new ] -{ #category : 'accessing-adapters' } +{ #category : 'instance creation' } BioAbstractAdapter class >> adapterClass [ - "Answer the preferred subclass for providing the receiver's services" - - ^ self validAdapters - detect: [ : cls | cls isPreferredAdapter ] - ifNone: [ self validAdapters first ] + "Answer the preferred subclass for providing the receiver's services." + + | preferred | + preferred := self preferredAdapterClassForCurrentPlatform. + preferred ifNotNil: [ + (self validAdapters includes: preferred) ifTrue: [ ^ preferred ] ]. + + ^ self validAdapters + detect: [ :cls | cls isPreferredAdapter ] + ifNone: [ + self validAdapters + ifEmpty: [ self signalInvalidObject: 'No provider was found' ] + ifNotEmpty: [ :adapters | adapters first ] ] ] { #category : 'accessing' } @@ -78,6 +86,20 @@ BioAbstractAdapter class >> hasAnyProvider [ ^ self allFinalClasses anySatisfy: [ : cls | cls providerIsAvailable ] ] +{ #category : 'testing' } +BioAbstractAdapter class >> isGTImage [ + "Answer whether the current image is a Glamorous Toolkit image." + + ^ Smalltalk globals includesKey: #GtImage +] + +{ #category : 'testing' } +BioAbstractAdapter class >> isPharoImage [ + "Answer whether the current image is a standard Pharo image (including GT, unless explicitly handled)." + + ^ self isGTImage not +] + { #category : 'accessing' } BioAbstractAdapter class >> isPreferred [ @@ -92,6 +114,23 @@ BioAbstractAdapter class >> isPreferredAdapter [ ^ false ] +{ #category : 'private' } +BioAbstractAdapter class >> preferredAdapterClassForCurrentPlatform [ + "Answer the adapter class that best matches the current image/platform. + Prefer modern subprocess engines on Pharo/GToolkit, keep legacy engines as fallback." + + | os | + os := BioOSInterfaceEngine adapter. + + (self isGTImage and: [ os isRunningInUnix ]) ifTrue: [ + ^ BioGtUnixSubprocess ]. + + (self isPharoImage and: [ os isRunningInUnix ]) ifTrue: [ + ^ OSSUnixSubprocess ]. + + ^ nil +] + { #category : 'accessing' } BioAbstractAdapter class >> providerClass [ " Answer a , the main external class name for this adapter " diff --git a/repository/BioTools/BioGtUnixSubprocess.class.st b/repository/BioTools/BioGtUnixSubprocess.class.st new file mode 100644 index 00000000..88fba17c --- /dev/null +++ b/repository/BioTools/BioGtUnixSubprocess.class.st @@ -0,0 +1,87 @@ +" +Execution engine backed by GToolkit subprocess API for running shell commands and retrieving output. +" +Class { + #name : 'BioGtUnixSubprocess', + #superclass : 'BioExecutionEngine', + #category : 'BioTools', + #package : 'BioTools' +} + +{ #category : 'executing' } +BioGtUnixSubprocess class >> executeCommand: aCommandName [ + "See superimplementor's comment" + + ^ [ self executeGtSubprocessCommand: aCommandName ] + on: Warning + do: [ :ex | ex resume ] +] + +{ #category : 'executing' } +BioGtUnixSubprocess class >> executeCommand: aCommandName parameter: parameterName [ + "See superimplementor's comment" + + ^ self executeGtSubprocessCommand: (String streamContents: [ :stream | + stream + << aCommandName trimBoth; + space; + << parameterName trimBoth ]) +] + +{ #category : 'private' } +BioGtUnixSubprocess class >> executeGtSubprocessCommand: aCommandName [ + "Private - Execute aCommandName and answer a with any output returned" + + | subprocess | + + subprocess := (self classFor: self providerClass) new + shellCommand: aCommandName; + runAndWait; + yourself. + + ^ (subprocess stderr ifNotEmpty: [ subprocess stderr ] ifEmpty: [ subprocess stdout ]) trimBoth +] + +{ #category : 'executing' } +BioGtUnixSubprocess class >> executeMonitoring: aCommandName [ + "See superimplementor's comment" + + ^ self executeCommand: aCommandName +] + +{ #category : 'testing' } +BioGtUnixSubprocess class >> isPreferredAdapter [ + "Private - See superimplementor's comment" + + ^ self isRunningInUnix +] + +{ #category : 'accessing' } +BioGtUnixSubprocess class >> locateProgram: programName [ + "Answer a with the full qualified path to programName if can be located by the which command" + + ^ self programLocation isEmpty + ifTrue: [ self locateProgramNamed: programName ] + ifFalse: [ self programLocation ] +] + +{ #category : 'accessing' } +BioGtUnixSubprocess class >> locateProgramNamed: programName [ + "Answer a with the path to programName, if located, or an empty String otherwise" + + | subprocess | + + subprocess := GtSubprocessWithInMemoryOutput new + shellCommand: 'where ' , programName; + runAndWait; + yourself. + + ^ (subprocess stderr ifNotEmpty: [ subprocess stderr ] ifEmpty: [ subprocess stdout ]) trimBoth +] + +{ #category : 'private' } +BioGtUnixSubprocess class >> providerClass [ + "Private - See superimplementor's comment" + + ^ #GtUnixSubprocess +]