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..35c9bd0 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -19,36 +19,46 @@ 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 ] @@ -500,6 +510,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 [ diff --git a/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st new file mode 100644 index 0000000..f4b9de9 --- /dev/null +++ b/source/Sagan-GemStone-Tests/SemaphorizedGemStoneRepository.class.st @@ -0,0 +1,32 @@ +" +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 : '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 ]