From 01aff011fb9199f7ea1b8585519fd1d7f5231a2b Mon Sep 17 00:00:00 2001
From: Guille Polito <guillermopolito@gmail.com>
Date: Fri, 22 Dec 2023 09:51:30 +0100
Subject: [PATCH 1/2] Defer tests to the morphic ui thread

---
 .../SpCodeInteractionModelTest.class.st       |   2 +-
 .../SpCodePopoverPrintPresenterTest.class.st  |   2 +-
 src/Spec2-Tests/SpBasePresenterTest.class.st  | 161 ++++++++++++++++
 src/Spec2-Tests/SpBaseTest.class.st           | 177 +++---------------
 src/Spec2-Tests/SpSpecTest.class.st           |   2 +-
 5 files changed, 193 insertions(+), 151 deletions(-)
 create mode 100644 src/Spec2-Tests/SpBasePresenterTest.class.st

diff --git a/src/Spec2-Code-Tests/SpCodeInteractionModelTest.class.st b/src/Spec2-Code-Tests/SpCodeInteractionModelTest.class.st
index 477bf636..16530efb 100644
--- a/src/Spec2-Code-Tests/SpCodeInteractionModelTest.class.st
+++ b/src/Spec2-Code-Tests/SpCodeInteractionModelTest.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'SpCodeInteractionModelTest',
-	#superclass : 'TestCase',
+	#superclass : 'SpBaseTest',
 	#instVars : [
 		'interactionModel'
 	],
diff --git a/src/Spec2-Code-Tests/SpCodePopoverPrintPresenterTest.class.st b/src/Spec2-Code-Tests/SpCodePopoverPrintPresenterTest.class.st
index 48e428d9..a853424c 100644
--- a/src/Spec2-Code-Tests/SpCodePopoverPrintPresenterTest.class.st
+++ b/src/Spec2-Code-Tests/SpCodePopoverPrintPresenterTest.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'SpCodePopoverPrintPresenterTest',
-	#superclass : 'TestCase',
+	#superclass : 'SpBaseTest',
 	#instVars : [
 		'presenter'
 	],
diff --git a/src/Spec2-Tests/SpBasePresenterTest.class.st b/src/Spec2-Tests/SpBasePresenterTest.class.st
new file mode 100644
index 00000000..1ac0f65e
--- /dev/null
+++ b/src/Spec2-Tests/SpBasePresenterTest.class.st
@@ -0,0 +1,161 @@
+Class {
+	#name : 'SpBasePresenterTest',
+	#superclass : 'SpBaseTest',
+	#instVars : [
+		'presenter',
+		'window'
+	],
+	#category : 'Spec2-Tests-Utils',
+	#package : 'Spec2-Tests',
+	#tag : 'Utils'
+}
+
+{ #category : 'testing' }
+SpBasePresenterTest class >> isAbstract [
+
+	^ self = SpBasePresenterTest
+]
+
+{ #category : 'accessing' }
+SpBasePresenterTest >> adapter [
+
+	^ self subclassResponsibility
+]
+
+{ #category : 'assertions' }
+SpBasePresenterTest >> assertEvent: anEventName isRaisedInPresenter: aPresenter whenDoing: aBlock [
+	
+	self
+		assertWith: [ :times | times > 0 ]
+		timesRaisedEvent: anEventName
+		inPresenter: aPresenter
+		whenDoing: aBlock
+]
+
+{ #category : 'assertions' }
+SpBasePresenterTest >> assertWith: assertionBlock timesRaisedEvent: anEventName inPresenter: aPresenter whenDoing: actionBlock [
+	
+	| timesCalled |
+	timesCalled := 0.
+	aPresenter perform: anEventName with: [ timesCalled := timesCalled + 1 ].
+	actionBlock value.
+	assertionBlock value: timesCalled
+]
+
+{ #category : 'accessing' }
+SpBasePresenterTest >> classToTest [
+	self subclassResponsibility
+]
+
+{ #category : 'assertions' }
+SpBasePresenterTest >> denyEvent: anEventName isRaisedInPresenter: aPresenter whenDoing: aBlock [
+	
+	self
+		assertWith: [ :times | times = 0 ]
+		timesRaisedEvent: anEventName
+		inPresenter: aPresenter
+		whenDoing: aBlock
+]
+
+{ #category : 'initialization' }
+SpBasePresenterTest >> initializeTestedInstance [
+]
+
+{ #category : 'utilities' }
+SpBasePresenterTest >> openInstance [
+
+	window ifNil: [ window := presenter open ]
+]
+
+{ #category : 'accessing' }
+SpBasePresenterTest >> presenter [
+	^ presenter
+]
+
+{ #category : 'running' }
+SpBasePresenterTest >> setUp [
+	super setUp.
+	presenter := self classToTest newApplication: self application.
+	self initializeTestedInstance
+]
+
+{ #category : 'running' }
+SpBasePresenterTest >> tearDown [
+	window ifNotNil: [ window delete ].
+	super tearDown
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testNewPresenterIsNotBuilt [
+	self deny: presenter isBuilt
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testNewPresenterIsNotDisplayed [
+	self deny: presenter isDisplayed
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testNonOpenPresenterDoesNotRaiseBuiltEvent [
+	| built |
+	built := false.
+	presenter whenBuiltDo: [ built := true ].
+	self deny: built
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testNonOpenPresenterDoesNotRaiseDisplayedEvent [
+	| displayed |
+	displayed := false.
+	presenter whenDisplayDo: [ displayed := true ].
+	self deny: displayed
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testOpenPresenterIsBuilt [
+	self openInstance.
+	self assert: presenter isBuilt
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testOpenPresenterIsDisplayed [
+	self openInstance.
+	self assert: presenter isDisplayed
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testOpenPresenterRaisesBuiltEvent [
+	| built |
+	built := false.
+	presenter whenBuiltDo: [ built := true ].
+	self openInstance.
+	self assert: built
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testOpenPresenterRaisesDisplayEvent [
+	| displayed |
+	displayed := false.
+	presenter whenDisplayDo: [ displayed := true ].
+	self openInstance.
+	self assert: displayed
+]
+
+{ #category : 'tests' }
+SpBasePresenterTest >> testRebuildPresenterDoNotLetReferencesInAnnouncer [
+
+	| oldSize newSize |
+	presenter build.
+	oldSize := presenter announcer subscriptions subscriptions size.
+	"rebuild"
+	presenter build.
+	newSize := presenter announcer subscriptions subscriptions size.
+
+	self assert: oldSize equals: newSize
+]
+
+{ #category : 'accessing' }
+SpBasePresenterTest >> widget [
+	
+	^ self adapter widget
+]
diff --git a/src/Spec2-Tests/SpBaseTest.class.st b/src/Spec2-Tests/SpBaseTest.class.st
index 583f19fb..8b32e124 100644
--- a/src/Spec2-Tests/SpBaseTest.class.st
+++ b/src/Spec2-Tests/SpBaseTest.class.st
@@ -1,167 +1,48 @@
+"
+I am an abstract test class that makes all my subclass' test run on the UI thread to avoid concurrency issues.
+"
 Class {
 	#name : 'SpBaseTest',
 	#superclass : 'TestCase',
-	#instVars : [
-		'presenter',
-		'window'
-	],
 	#category : 'Spec2-Tests-Utils',
 	#package : 'Spec2-Tests',
 	#tag : 'Utils'
 }
 
-{ #category : 'testing' }
-SpBaseTest class >> isAbstract [
-
-	^ self = SpBaseTest
-]
-
-{ #category : 'accessing' }
-SpBaseTest >> adapter [
-
-	^ self subclassResponsibility
-]
-
 { #category : 'running' }
 SpBaseTest >> application [
-	
-	^ SpApplication new
-]
-
-{ #category : 'assertions' }
-SpBaseTest >> assertEvent: anEventName isRaisedInPresenter: aPresenter whenDoing: aBlock [
-	
-	self
-		assertWith: [ :times | times > 0 ]
-		timesRaisedEvent: anEventName
-		inPresenter: aPresenter
-		whenDoing: aBlock
-]
-
-{ #category : 'assertions' }
-SpBaseTest >> assertWith: assertionBlock timesRaisedEvent: anEventName inPresenter: aPresenter whenDoing: actionBlock [
-	
-	| timesCalled |
-	timesCalled := 0.
-	aPresenter perform: anEventName with: [ timesCalled := timesCalled + 1 ].
-	actionBlock value.
-	assertionBlock value: timesCalled
-]
-
-{ #category : 'accessing' }
-SpBaseTest >> classToTest [
-	self subclassResponsibility
-]
-
-{ #category : 'assertions' }
-SpBaseTest >> denyEvent: anEventName isRaisedInPresenter: aPresenter whenDoing: aBlock [
-	
-	self
-		assertWith: [ :times | times = 0 ]
-		timesRaisedEvent: anEventName
-		inPresenter: aPresenter
-		whenDoing: aBlock
-]
-
-{ #category : 'initialization' }
-SpBaseTest >> initializeTestedInstance [
-]
-
-{ #category : 'utilities' }
-SpBaseTest >> openInstance [
-
-	window ifNil: [ window := presenter open ]
-]
-
-{ #category : 'accessing' }
-SpBaseTest >> presenter [
-	^ presenter
-]
 
-{ #category : 'running' }
-SpBaseTest >> setUp [
-	super setUp.
-	presenter := self classToTest newApplication: self application.
-	self initializeTestedInstance
+	^ SpApplication new
+		  useMorphic;
+		  yourself
 ]
 
 { #category : 'running' }
-SpBaseTest >> tearDown [
-	window ifNotNil: [ window delete ].
-	super tearDown
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testNewPresenterIsNotBuilt [
-	self deny: presenter isBuilt
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testNewPresenterIsNotDisplayed [
-	self deny: presenter isDisplayed
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testNonOpenPresenterDoesNotRaiseBuiltEvent [
-	| built |
-	built := false.
-	presenter whenBuiltDo: [ built := true ].
-	self deny: built
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testNonOpenPresenterDoesNotRaiseDisplayedEvent [
-	| displayed |
-	displayed := false.
-	presenter whenDisplayDo: [ displayed := true ].
-	self deny: displayed
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testOpenPresenterIsBuilt [
-	self openInstance.
-	self assert: presenter isBuilt
-]
+SpBaseTest >> run [
 
-{ #category : 'tests' }
-SpBaseTest >> testOpenPresenterIsDisplayed [
-	self openInstance.
-	self assert: presenter isDisplayed
-]
-
-{ #category : 'tests' }
-SpBaseTest >> testOpenPresenterRaisesBuiltEvent [
-	| built |
-	built := false.
-	presenter whenBuiltDo: [ built := true ].
-	self openInstance.
-	self assert: built
-]
+	| finished result |
+	UIManager default uiProcess == Processor activeProcess ifTrue: [
+		^ super run ].
 
-{ #category : 'tests' }
-SpBaseTest >> testOpenPresenterRaisesDisplayEvent [
-	| displayed |
-	displayed := false.
-	presenter whenDisplayDo: [ displayed := true ].
-	self openInstance.
-	self assert: displayed
+	finished := Semaphore new.
+	self application defer: [
+		result := super run.
+		finished signal ].
+	finished wait.
+	^ result
 ]
 
-{ #category : 'tests' }
-SpBaseTest >> testRebuildPresenterDoNotLetReferencesInAnnouncer [
-
-	| oldSize newSize |
-	presenter build.
-	oldSize := presenter announcer subscriptions subscriptions size.
-	"rebuild"
-	presenter build.
-	newSize := presenter announcer subscriptions subscriptions size.
-
-	self assert: oldSize equals: newSize
-]
-
-{ #category : 'accessing' }
-SpBaseTest >> widget [
-	
-	^ self adapter widget
+{ #category : 'running' }
+SpBaseTest >> run: aResult [
+
+	| finished result |
+	UIManager default uiProcess == Processor activeProcess ifTrue: [
+		^ super run: aResult ].
+
+	finished := Semaphore new.
+	self application backend defer: [
+		result := super run: aResult.
+		finished signal ].
+	finished wait.
+	^ result
 ]
diff --git a/src/Spec2-Tests/SpSpecTest.class.st b/src/Spec2-Tests/SpSpecTest.class.st
index 1e731f93..a2c07fac 100644
--- a/src/Spec2-Tests/SpSpecTest.class.st
+++ b/src/Spec2-Tests/SpSpecTest.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'SpSpecTest',
-	#superclass : 'SpBaseTest',
+	#superclass : 'SpBasePresenterTest',
 	#category : 'Spec2-Tests-Utils',
 	#package : 'Spec2-Tests',
 	#tag : 'Utils'

From dcc99206f3207bcc911f6f47425f851cb59cb300 Mon Sep 17 00:00:00 2001
From: Guille Polito <guillermopolito@gmail.com>
Date: Fri, 22 Dec 2023 10:10:08 +0100
Subject: [PATCH 2/2] useMorphic is not available in SpApplication

---
 src/Spec2-Tests/SpBaseTest.class.st | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Spec2-Tests/SpBaseTest.class.st b/src/Spec2-Tests/SpBaseTest.class.st
index 8b32e124..8cffdcb0 100644
--- a/src/Spec2-Tests/SpBaseTest.class.st
+++ b/src/Spec2-Tests/SpBaseTest.class.st
@@ -13,7 +13,7 @@ Class {
 SpBaseTest >> application [
 
 	^ SpApplication new
-		  useMorphic;
+		  useBackend: #Morphic with: StPharoMorphicConfiguration new;
 		  yourself
 ]