From 85d48af1da127cac462f52d19aec610f2c841d29 Mon Sep 17 00:00:00 2001 From: adebonis Date: Tue, 24 Sep 2024 13:03:21 -0300 Subject: [PATCH 1/3] Improving transaction management in crud services of repositories --- .../RepositoryBasedTest.class.st | 18 ++-- source/Sagan-Core/RepositoryBehavior.class.st | 26 +++-- .../GemStoneRepositoryProviderTest.class.st | 97 ++++++++++++++++--- .../SemaphorizedGemStoneRepository.class.st | 46 +++++++++ ...horizedGemStoneRepositoryProvider.class.st | 58 +++++++++++ .../GemStoneRepository.class.st | 30 +++--- 6 files changed, 227 insertions(+), 48 deletions(-) create mode 100644 source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st create mode 100644 source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepositoryProvider.class.st diff --git a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st index 189d01a..92f9097 100644 --- a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st +++ b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st @@ -603,12 +603,9 @@ RepositoryBasedTest >> testUpdateInSameSessionAsFetch [ stallone := self silvesterStallone. self extraterrestrials - transact: [ self extraterrestrials - withOneMatching: [ :extraterrestrial | extraterrestrial firstName = 'John' ] - do: [ :lock | self extraterrestrials update: lock with: stallone ] - else: [ self fail ] - ]. - + withOneMatching: [ :extraterrestrial | extraterrestrial firstName = 'John' ] + do: [ :lock | self extraterrestrials update: lock with: stallone ] + else: [ self fail ]. self assertTheOnlyOneInTheRepositoryIsSilvesterStallone ] @@ -784,9 +781,8 @@ RepositoryBasedTest >> testWithOneWhereIsDoElse [ RepositoryBasedTest >> updateExtraterrestrialMatching: aBlock with: aNewExtraterrestrial [ self extraterrestrials - transact: [ self extraterrestrials - withOneMatching: aBlock - do: [ :extraterrestrial | self extraterrestrials update: extraterrestrial with: aNewExtraterrestrial ] - else: [ self fail ] - ] + withOneMatching: aBlock + do: [ :extraterrestrial | + self extraterrestrials update: extraterrestrial with: aNewExtraterrestrial ] + else: [ self fail ] ] diff --git a/source/Sagan-Core/RepositoryBehavior.class.st b/source/Sagan-Core/RepositoryBehavior.class.st index a6176e3..2458d45 100644 --- a/source/Sagan-Core/RepositoryBehavior.class.st +++ b/source/Sagan-Core/RepositoryBehavior.class.st @@ -131,9 +131,11 @@ RepositoryBehavior >> matchingCriteriaBuilder [ { #category : 'management' } RepositoryBehavior >> purge: aDomainObject [ - ^ self - assertIncludes: aDomainObject; - purgeAfterCheckingInclusion: aDomainObject + ^ self transact: [ + self + assertIncludes: aDomainObject; + purgeAfterCheckingInclusion: aDomainObject + ] ] { #category : 'private - management' } @@ -151,9 +153,11 @@ RepositoryBehavior >> purgeAllMatching: aCriteria [ { #category : 'management' } RepositoryBehavior >> store: aDomainObject [ - ^ self - assertNoConflictsFor: aDomainObject; - storeAfterCheckingConflicts: aDomainObject + ^ self transact: [ + self + assertNoConflictsFor: aDomainObject; + storeAfterCheckingConflicts: aDomainObject + ] ] { #category : 'private - management' } @@ -177,10 +181,12 @@ RepositoryBehavior >> update: aDomainObject executing: aBlock [ { #category : 'management' } RepositoryBehavior >> update: aDomainObject with: anUpdatedDomainObject [ - ^ self - assertIncludes: aDomainObject; - assertNoConflictsFor: anUpdatedDomainObject excluding: aDomainObject; - updateAfterCheckingConflicts: aDomainObject with: anUpdatedDomainObject + ^ self transact: [ + self + assertIncludes: aDomainObject; + assertNoConflictsFor: anUpdatedDomainObject excluding: aDomainObject; + updateAfterCheckingConflicts: aDomainObject with: anUpdatedDomainObject + ] ] { #category : 'private - management' } diff --git a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st index bf9cb74..1702406 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -19,39 +19,77 @@ GemStoneRepositoryProviderTest >> pickTwoElementsFrom: aQuery [ ] { #category : 'initialization' } -GemStoneRepositoryProviderTest >> setUpRepositoryWith: aConflictCheckingStrategy [ +GemStoneRepositoryProviderTest >> setUpRepositoryProvidedBy: aGemStoneRepositoryProvider with: aConflictCheckingStrategy [ - extraterrestrials := GemStoneRepositoryProvider new + extraterrestrials := aGemStoneRepositoryProvider createRepositoryStoringObjectsOfType: Extraterrestrial checkingConflictsAccordingTo: aConflictCheckingStrategy. extraterrestrials configureWith: [ :repository | - repository - indexByEquality: 'firstName' typed: String; - indexByEquality: 'lastName' typed: String + repository + indexByEquality: 'firstName' typed: String; + indexByEquality: 'lastName' typed: String ]. ships := GemStoneRepositoryProvider new createRepositoryStoringObjectsOfType: Spaceship checkingConflictsAccordingTo: aConflictCheckingStrategy ] +{ #category : 'initialization' } +GemStoneRepositoryProviderTest >> setUpRepositoryWith: aConflictCheckingStrategy [ + + self setUpRepositoryProvidedBy: GemStoneRepositoryProvider new with: aConflictCheckingStrategy +] + +{ #category : 'initialization' } +GemStoneRepositoryProviderTest >> setUpSemaphorizedRepositoryWaitingOn: aSemaphore [ + + self + setUpRepositoryProvidedBy: ( SemaphorizedGemStoneRepositoryProvider waitingOn: aSemaphore ) + with: DoNotCheckForConflictsStrategy new +] + { #category : 'tests' } GemStoneRepositoryProviderTest >> testExceptionsAbortTransactionsUntilHandled [ self assert: self extraterrestrials findAll isEmpty. - - self extraterrestrials transact: [ - [ + [ self extraterrestrials store: self silvesterStallone. self assertTheOnlyOneInTheRepositoryIsSilvesterStallone. 1 / 0 - ] - on: ZeroDivide - do: [ :ex | ex return ] - ]. - + ] + on: ZeroDivide + do: [ :ex | ex return ]. self assertTheOnlyOneInTheRepositoryIsSilvesterStallone ] +{ #category : 'tests - conflict checking' } +GemStoneRepositoryProviderTest >> testPurgeInSimultaneous [ + + | semaphore previous | + + previous := System transactionMode. + [ + System transactionMode: #manualBegin. + semaphore := Semaphore new. + self + setUpRepositoryProvidedBy: ( SemaphorizedGemStoneRepositoryProvider waitingOn: semaphore ) + with: + ( CriteriaBasedConflictCheckingStrategy forSingleAspectMatching: [ :person | person firstName ] ). + [ self extraterrestrials store: self silvesterStallone ] fork. + Processor yield. + semaphore signal. + [ self extraterrestrials purge: self silvesterStallone ] fork. + Processor yield. + [ self should: [ self extraterrestrials purge: self silvesterStallone ] raise: ObjectNotFound ] + fork. + Processor yield. + semaphore signal. + semaphore signal. + Processor yield. + self assert: self extraterrestrials findAll isEmpty + ] ensure: [ System transactionMode: previous ] +] + { #category : 'tests' } GemStoneRepositoryProviderTest >> testQueryReturningBeforeAllIndexedResultsAreRead [ @@ -417,6 +455,39 @@ GemStoneRepositoryProviderTest >> testSpaceshipWhenUsingIdentityIndex [ ] ] +{ #category : 'tests - conflict checking' } +GemStoneRepositoryProviderTest >> testStoreInSimultaneous [ + + | semaphore previous | + + previous := System transactionMode. + [ + System transactionMode: #manualBegin. + semaphore := Semaphore new. + self + setUpRepositoryProvidedBy: ( SemaphorizedGemStoneRepositoryProvider waitingOn: semaphore ) + with: + ( CriteriaBasedConflictCheckingStrategy forSingleAspectMatching: [ :person | person firstName ] ). + [ self extraterrestrials store: self silvesterStallone ] fork. + Processor yield. + [ + self + should: [ self extraterrestrials store: self silvesterStallone ] + raise: ConflictingObjectFound + withMessageText: 'Something is in conflict with Stallone, Silvester' + ] fork. + Processor yield. + semaphore signal. + semaphore signal. + Processor yield. + self withTheOnlyOneIn: self extraterrestrials findAll do: [ :extraterrestrial | + self + assert: extraterrestrial firstName equals: 'Silvester'; + assert: extraterrestrial lastName equals: 'Stallone' + ] + ] ensure: [ System transactionMode: previous ] +] + { #category : 'tests' } GemStoneRepositoryProviderTest >> testStreamQueryResults [ diff --git a/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st new file mode 100644 index 0000000..4da19d7 --- /dev/null +++ b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st @@ -0,0 +1,46 @@ +" +This class is specifically created for testing transaction management in crud services of repostiories +" +Class { + #name : 'SemaphorizedGemStoneRepository', + #superclass : 'GemStoneRepository', + #instVars : [ + 'semaphore' + ], + #category : 'Sagan-GemStone-Tests', + #package : 'Sagan-GemStone-Tests' +} + +{ #category : 'instance creation' } +SemaphorizedGemStoneRepository class >> checkingConflictsAccordingTo: aConflictCheckingStrategy waitingOn: aSemaphore [ + + ^ self new initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy waitingOn: aSemaphore +] + +{ #category : 'private - preconditions' } +SemaphorizedGemStoneRepository >> assertIncludes: aDomainObject [ + + super assertIncludes: aDomainObject. + semaphore wait +] + +{ #category : 'private - preconditions' } +SemaphorizedGemStoneRepository >> assertNoConflictsFor: aDomainObject [ + + super assertNoConflictsFor: aDomainObject. + semaphore wait +] + +{ #category : 'initialization' } +SemaphorizedGemStoneRepository >> initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy waitingOn: aSemaphore [ + + self initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy. + semaphore := aSemaphore +] + +{ #category : 'private - management' } +SemaphorizedGemStoneRepository >> synchronize: aDomainObject with: anUpdatedDomainObject [ + + super synchronize: aDomainObject with: anUpdatedDomainObject. + semaphore wait +] diff --git a/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepositoryProvider.class.st b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepositoryProvider.class.st new file mode 100644 index 0000000..9c4fdc3 --- /dev/null +++ b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepositoryProvider.class.st @@ -0,0 +1,58 @@ +" +This class is specifically created for testing transaction management in crud services of repostiories +" +Class { + #name : 'SemaphorizedGemStoneRepositoryProvider', + #superclass : 'RepositoryProvider', + #instVars : [ + 'semaphore' + ], + #category : 'Sagan-GemStone-Tests', + #package : 'Sagan-GemStone-Tests' +} + +{ #category : 'instance creation' } +SemaphorizedGemStoneRepositoryProvider class >> waitingOn: aSemaphore [ + + ^ self new initializeWaitingOn: aSemaphore +] + +{ #category : 'building' } +SemaphorizedGemStoneRepositoryProvider >> createRepositoryStoringObjectsOfType: aBusinessObjectClass + checkingConflictsAccordingTo: aConflictCheckingStrategy [ + + + ^ SemaphorizedGemStoneRepository + checkingConflictsAccordingTo: aConflictCheckingStrategy + waitingOn: semaphore +] + +{ #category : 'controlling' } +SemaphorizedGemStoneRepositoryProvider >> destroyRepositories [ + + IndexManager current removeAllIndexes +] + +{ #category : 'initialization' } +SemaphorizedGemStoneRepositoryProvider >> initializeWaitingOn: aSemaphore [ + + semaphore := aSemaphore +] + +{ #category : 'controlling' } +SemaphorizedGemStoneRepositoryProvider >> prepareForInitialPersistence [ + + +] + +{ #category : 'controlling' } +SemaphorizedGemStoneRepositoryProvider >> prepareForShutDown [ + + +] + +{ #category : 'initialization' } +SemaphorizedGemStoneRepositoryProvider >> reset [ + + +] diff --git a/source/Sagan-GemStone/GemStoneRepository.class.st b/source/Sagan-GemStone/GemStoneRepository.class.st index 5481bc8..d2bc49d 100644 --- a/source/Sagan-GemStone/GemStoneRepository.class.st +++ b/source/Sagan-GemStone/GemStoneRepository.class.st @@ -127,14 +127,12 @@ GemStoneRepository >> matchingCriteriaBuilder [ { #category : 'private - management' } GemStoneRepository >> purgeAfterCheckingInclusion: aDomainObject [ - ^ self transact: [ - contents remove: aDomainObject ifAbsent: [ - DataInconsistencyFound signal: - ( '<1p> was expected to be found in the contents, but it was not.' expandMacrosWith: - aDomainObject ) - ]. - aDomainObject - ] + contents remove: aDomainObject ifAbsent: [ + DataInconsistencyFound signal: + ( '<1p> was expected to be found in the contents, but it was not.' expandMacrosWith: + aDomainObject ) + ]. + ^ aDomainObject ] { #category : 'management' } @@ -153,10 +151,14 @@ GemStoneRepository >> saganGemStoneIndexOptions [ { #category : 'private - management' } GemStoneRepository >> storeAfterCheckingConflicts: aDomainObject [ - ^ self transact: [ - contents add: aDomainObject. - aDomainObject - ] + contents add: aDomainObject. + ^ aDomainObject +] + +{ #category : 'private - management' } +GemStoneRepository >> synchronize: aDomainObject with: anUpdatedDomainObject [ + + aDomainObject synchronizeWith: anUpdatedDomainObject ] { #category : 'management' } @@ -175,8 +177,8 @@ GemStoneRepository >> update: aMutableDomainObject executing: aBlock [ GemStoneRepository >> updateAfterCheckingConflicts: aDomainObject with: anUpdatedDomainObject [ self purgeAfterCheckingInclusion: aDomainObject. - [ aDomainObject synchronizeWith: anUpdatedDomainObject ] ensure: [ - self storeAfterCheckingConflicts: aDomainObject ]. + [ self synchronize: aDomainObject with: anUpdatedDomainObject ] ensure: [ + self storeAfterCheckingConflicts: aDomainObject ]. ^ aDomainObject ] From b940618b07585e63b07e7b1bfa18ec20d244bd94 Mon Sep 17 00:00:00 2001 From: adebonis Date: Tue, 24 Sep 2024 13:05:55 -0300 Subject: [PATCH 2/3] Improving transaction management in crud services in repositories --- .../GemStoneRepositoryProviderTest.class.st | 34 +++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st index 1702406..956fc2c 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -571,6 +571,40 @@ GemStoneRepositoryProviderTest >> testTransactionLevelWithUnhandledException [ self assert: System transactionLevel equals: baseLevel ] +{ #category : 'tests' } +GemStoneRepositoryProviderTest >> testUpdateWithWhileAbbortTransactionsAreSignaled [ + + | stallone semaphore previous | + + previous := System transactionMode. + [ + System transactionMode: #manualBegin. + semaphore := Semaphore new. + self setUpSemaphorizedRepositoryWaitingOn: semaphore. + stallone := self silvesterStallone. + self extraterrestrials store: stallone. + self + assert: self extraterrestrials findAll size equals: 1; + assert: ( self extraterrestrials findAll includes: stallone ). + [ + self + updateExtraterrestrialMatching: [ :extraterrestrial | extraterrestrial firstName = 'Silvester' ] + with: self johnLock + ] fork. + Processor yield. + System inTransaction ifFalse: [ System abortTransaction ]. + semaphore signal. + Processor yield. + self assert: self extraterrestrials findAll size equals: 1. + self extraterrestrials + withOneMatching: [ :extraterrestrial | extraterrestrial firstName = 'John' ] + do: [ :john | self assert: john lastName equals: 'Lock' ] + else: [ self fail ]. + self assert: ( self extraterrestrials findAllMatching: [ :extraterrestrial | + extraterrestrial lastName = 'Stallone' ] ) isEmpty + ] ensure: [ System transactionMode: previous ] +] + { #category : 'utility' } GemStoneRepositoryProviderTest >> withAllSpaceshipsMatching: aMatchingCriteria do: aOneArgBlock [ From 4a5de0adbc7809add3d2686db9f21a509d02c391 Mon Sep 17 00:00:00 2001 From: adebonis Date: Wed, 25 Sep 2024 10:16:02 -0300 Subject: [PATCH 3/3] Removing tests which do not show known use cases --- .../GemStoneRepositoryProviderTest.class.st | 61 ------------------- .../SemaphorizedGemStoneRepository.class.st | 14 ----- 2 files changed, 75 deletions(-) diff --git a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st index 956fc2c..35c9bd0 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -62,34 +62,6 @@ GemStoneRepositoryProviderTest >> testExceptionsAbortTransactionsUntilHandled [ self assertTheOnlyOneInTheRepositoryIsSilvesterStallone ] -{ #category : 'tests - conflict checking' } -GemStoneRepositoryProviderTest >> testPurgeInSimultaneous [ - - | semaphore previous | - - previous := System transactionMode. - [ - System transactionMode: #manualBegin. - semaphore := Semaphore new. - self - setUpRepositoryProvidedBy: ( SemaphorizedGemStoneRepositoryProvider waitingOn: semaphore ) - with: - ( CriteriaBasedConflictCheckingStrategy forSingleAspectMatching: [ :person | person firstName ] ). - [ self extraterrestrials store: self silvesterStallone ] fork. - Processor yield. - semaphore signal. - [ self extraterrestrials purge: self silvesterStallone ] fork. - Processor yield. - [ self should: [ self extraterrestrials purge: self silvesterStallone ] raise: ObjectNotFound ] - fork. - Processor yield. - semaphore signal. - semaphore signal. - Processor yield. - self assert: self extraterrestrials findAll isEmpty - ] ensure: [ System transactionMode: previous ] -] - { #category : 'tests' } GemStoneRepositoryProviderTest >> testQueryReturningBeforeAllIndexedResultsAreRead [ @@ -455,39 +427,6 @@ GemStoneRepositoryProviderTest >> testSpaceshipWhenUsingIdentityIndex [ ] ] -{ #category : 'tests - conflict checking' } -GemStoneRepositoryProviderTest >> testStoreInSimultaneous [ - - | semaphore previous | - - previous := System transactionMode. - [ - System transactionMode: #manualBegin. - semaphore := Semaphore new. - self - setUpRepositoryProvidedBy: ( SemaphorizedGemStoneRepositoryProvider waitingOn: semaphore ) - with: - ( CriteriaBasedConflictCheckingStrategy forSingleAspectMatching: [ :person | person firstName ] ). - [ self extraterrestrials store: self silvesterStallone ] fork. - Processor yield. - [ - self - should: [ self extraterrestrials store: self silvesterStallone ] - raise: ConflictingObjectFound - withMessageText: 'Something is in conflict with Stallone, Silvester' - ] fork. - Processor yield. - semaphore signal. - semaphore signal. - Processor yield. - self withTheOnlyOneIn: self extraterrestrials findAll do: [ :extraterrestrial | - self - assert: extraterrestrial firstName equals: 'Silvester'; - assert: extraterrestrial lastName equals: 'Stallone' - ] - ] ensure: [ System transactionMode: previous ] -] - { #category : 'tests' } GemStoneRepositoryProviderTest >> testStreamQueryResults [ diff --git a/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st index 4da19d7..f4b9de9 100644 --- a/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st +++ b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st @@ -17,20 +17,6 @@ SemaphorizedGemStoneRepository class >> checkingConflictsAccordingTo: aConflictC ^ self new initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy waitingOn: aSemaphore ] -{ #category : 'private - preconditions' } -SemaphorizedGemStoneRepository >> assertIncludes: aDomainObject [ - - super assertIncludes: aDomainObject. - semaphore wait -] - -{ #category : 'private - preconditions' } -SemaphorizedGemStoneRepository >> assertNoConflictsFor: aDomainObject [ - - super assertNoConflictsFor: aDomainObject. - semaphore wait -] - { #category : 'initialization' } SemaphorizedGemStoneRepository >> initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy waitingOn: aSemaphore [