From 2d3a1ff224f716cd8c7bdef72e97f67306abeda5 Mon Sep 17 00:00:00 2001 From: MaximilianoTabacman Date: Thu, 8 Feb 2024 09:54:01 -0300 Subject: [PATCH 1/5] Added transact: to methods affecting the contents --- .../GemStoneRepository.class.st | 24 +++++++++++-------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/source/Sagan-GemStone/GemStoneRepository.class.st b/source/Sagan-GemStone/GemStoneRepository.class.st index 4559fb6..f52faa3 100644 --- a/source/Sagan-GemStone/GemStoneRepository.class.st +++ b/source/Sagan-GemStone/GemStoneRepository.class.st @@ -96,18 +96,20 @@ GemStoneRepository >> matchingCriteriaBuilder [ { #category : 'private - management' } GemStoneRepository >> purgeAfterCheckingInclusion: aDomainObject [ - contents remove: aDomainObject ifAbsent: [ - DataInconsistencyFound signal: - ( '<1p> was expected to be found in the contents, but it was not.' expandMacrosWith: - aDomainObject ) - ]. - ^ 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 + ] ] { #category : 'management' } GemStoneRepository >> purgeAllMatching: aCriteriaOrBlock [ - contents := contents reject: ( self asMatchingCriteria: aCriteriaOrBlock ) + self transact: [ contents := contents reject: ( self asMatchingCriteria: aCriteriaOrBlock ) ] ] { #category : 'private - accessing' } @@ -120,8 +122,10 @@ GemStoneRepository >> saganGemStoneIndexOptions [ { #category : 'private - management' } GemStoneRepository >> storeAfterCheckingConflicts: aDomainObject [ - contents add: aDomainObject. - ^ aDomainObject + ^ self transact: [ + contents add: aDomainObject. + aDomainObject + ] ] { #category : 'management' } @@ -133,7 +137,7 @@ GemStoneRepository >> transact: aBlock [ { #category : 'management' } GemStoneRepository >> update: aMutableDomainObject executing: aBlock [ - aBlock value: aMutableDomainObject + self transact: [ aBlock value: aMutableDomainObject ] ] { #category : 'private - management' } From 41b984a509c7fcdc5adae85996996ab96a533e8b Mon Sep 17 00:00:00 2001 From: MaximilianoTabacman Date: Thu, 8 Feb 2024 10:42:26 -0300 Subject: [PATCH 2/5] Added more uses of transact: --- .../GemStoneRepository.class.st | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/source/Sagan-GemStone/GemStoneRepository.class.st b/source/Sagan-GemStone/GemStoneRepository.class.st index f52faa3..47e8e69 100644 --- a/source/Sagan-GemStone/GemStoneRepository.class.st +++ b/source/Sagan-GemStone/GemStoneRepository.class.st @@ -65,19 +65,23 @@ GemStoneRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction { #category : 'configuring' } GemStoneRepository >> indexByEquality: aPath typed: aType [ - GsIndexSpec new - equalityIndex: ( 'each.<1s>' expandMacrosWith: aPath ) - lastElementClass: aType - options: self saganGemStoneIndexOptions; - createIndexesOn: contents + self transact: [ + GsIndexSpec new + equalityIndex: ( 'each.<1s>' expandMacrosWith: aPath ) + lastElementClass: aType + options: self saganGemStoneIndexOptions; + createIndexesOn: contents + ] ] { #category : 'configuring' } GemStoneRepository >> indexByIdentity: aPath [ - GsIndexSpec new - identityIndex: ( 'each.<1s>' expandMacrosWith: aPath ) options: self saganGemStoneIndexOptions; - createIndexesOn: contents + self transact: [ + GsIndexSpec new + identityIndex: ( 'each.<1s>' expandMacrosWith: aPath ) options: self saganGemStoneIndexOptions; + createIndexesOn: contents + ] ] { #category : 'initialization' } From 58c9ed2b0b4e55b4f0af2ec8f904a571f7c6cbe8 Mon Sep 17 00:00:00 2001 From: MaximilianoTabacman Date: Thu, 15 Feb 2024 16:37:44 -0300 Subject: [PATCH 3/5] Changed nested transaction behavior and corrected some of the tests --- .../GemStoneRepositoryProviderTest.class.st | 58 +++++++++---------- .../GemStoneTransaction.class.st | 21 +++---- 2 files changed, 38 insertions(+), 41 deletions(-) diff --git a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st index a788605..74a39b4 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -40,14 +40,10 @@ GemStoneRepositoryProviderTest >> testExceptionsAbortTransactionsUntilHandled [ self assert: self extraterrestrials findAll isEmpty. self extraterrestrials transact: [ + [ self extraterrestrials store: self silvesterStallone. self assertTheOnlyOneInTheRepositoryIsSilvesterStallone. - - [ - self extraterrestrials transact: [ - self extraterrestrials store: self johnTravolta. - 1 / 0 - ] + 1 / 0 ] on: ZeroDivide do: [ :ex | ex return ] @@ -340,54 +336,55 @@ GemStoneRepositoryProviderTest >> testStreamQueryResults [ { #category : 'tests' } GemStoneRepositoryProviderTest >> testTransactionLevel [ - | initialLevel | + | baseLevel | - initialLevel := System transactionLevel. - self assert: initialLevel >= 0. + baseLevel := System transactionLevel. self extraterrestrials transact: [ - self assert: System transactionLevel equals: initialLevel + 1. - self extraterrestrials transact: [ self assert: System transactionLevel equals: initialLevel + 2 ]. - self assert: System transactionLevel equals: initialLevel + 1 - ]. - self assert: System transactionLevel equals: initialLevel + | levelDuringTransaction | + levelDuringTransaction := System transactionLevel. + self extraterrestrials transact: [ + self assert: System transactionLevel equals: levelDuringTransaction ]. + self assert: System transactionLevel equals: levelDuringTransaction + ]. + self assert: System transactionLevel equals: baseLevel ] { #category : 'tests' } GemStoneRepositoryProviderTest >> testTransactionLevelWithManualAbort [ - | initialLevel | + | baseLevel | - initialLevel := System transactionLevel. - self assert: initialLevel >= 0. + baseLevel := System transactionLevel. self extraterrestrials transact: [ - self assert: System transactionLevel equals: initialLevel + 1. + | levelDuringTransaction | + + levelDuringTransaction := System transactionLevel. self extraterrestrials transact: [ - self assert: System transactionLevel equals: initialLevel + 2. + self assert: System transactionLevel equals: levelDuringTransaction. System abortTransaction. - self assert: System transactionLevel equals: initialLevel + 1 + self assert: System transactionLevel equals: levelDuringTransaction ]. - self assert: System transactionLevel equals: initialLevel. + self assert: System transactionLevel equals: levelDuringTransaction ]. - self assert: System transactionLevel equals: initialLevel - + self assert: System transactionLevel equals: baseLevel ] { #category : 'tests' } GemStoneRepositoryProviderTest >> testTransactionLevelWithUnhandledException [ - | initialLevel | - - initialLevel := System transactionLevel. - self assert: initialLevel >= 0. + | baseLevel | + baseLevel := System transactionLevel. [ + | levelDuringTransaction | + self extraterrestrials transact: [ - self assert: System transactionLevel equals: initialLevel + 1. + levelDuringTransaction := System transactionLevel. self extraterrestrials transact: [ - self assert: System transactionLevel equals: initialLevel + 2. + self assert: System transactionLevel equals: levelDuringTransaction. 1 / 0 ] ] @@ -395,8 +392,7 @@ GemStoneRepositoryProviderTest >> testTransactionLevelWithUnhandledException [ on: ZeroDivide do: [ :ex | ex return ]. - self assert: System transactionLevel equals: initialLevel - + self assert: System transactionLevel equals: baseLevel ] { #category : 'utility' } diff --git a/source/Sagan-GemStone/GemStoneTransaction.class.st b/source/Sagan-GemStone/GemStoneTransaction.class.st index ed97bd2..ad48413 100644 --- a/source/Sagan-GemStone/GemStoneTransaction.class.st +++ b/source/Sagan-GemStone/GemStoneTransaction.class.st @@ -11,15 +11,16 @@ Class { { #category : 'processing' } GemStoneTransaction >> transact: aBlock [ - | result | + ^ System inTransaction + ifTrue: aBlock + ifFalse: [ + | result | - System inTransaction - ifTrue: [ System beginNestedTransaction ] - ifFalse: [ System beginTransaction ]. - [ - result := aBlock value. - System commitTransaction - ] ifCurtailed: [ result := System abortTransaction ]. - - ^ result + System beginTransaction. + [ + result := aBlock value. + System commitTransaction + ] ifCurtailed: [ result := System abortTransaction ]. + result + ] ] From 60b1eed2041e2048dfc5f22d5249a64eb5721cfc Mon Sep 17 00:00:00 2001 From: MaximilianoTabacman Date: Thu, 15 Feb 2024 16:44:51 -0300 Subject: [PATCH 4/5] Removed test for nested transactions --- .../GemStoneRepositoryProviderTest.class.st | 21 ------------------- 1 file changed, 21 deletions(-) diff --git a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st index 74a39b4..ac3babe 100644 --- a/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st +++ b/source/Sagan-GemStone-Tests/GemStoneRepositoryProviderTest.class.st @@ -52,27 +52,6 @@ GemStoneRepositoryProviderTest >> testExceptionsAbortTransactionsUntilHandled [ self assertTheOnlyOneInTheRepositoryIsSilvesterStallone ] -{ #category : 'tests' } -GemStoneRepositoryProviderTest >> testNestedTransactions [ - - self assert: self extraterrestrials findAll isEmpty. - - self extraterrestrials transact: [ - self extraterrestrials store: self silvesterStallone. - self assertTheOnlyOneInTheRepositoryIsSilvesterStallone. - - System abortTransaction. - self assert: self extraterrestrials findAll isEmpty. - self extraterrestrials transact: [ self extraterrestrials store: self johnTravolta ] - ]. - - self withTheOnlyOneIn: self extraterrestrials findAll do: [ :extraterrestrial | - self - assert: extraterrestrial firstName equals: 'John'; - assert: extraterrestrial lastName equals: 'Travolta' - ] -] - { #category : 'tests' } GemStoneRepositoryProviderTest >> testQueryReturningBeforeAllIndexedResultsAreRead [ From 0228634b3e2301680b34e6e3afa122f3ca7fe0af Mon Sep 17 00:00:00 2001 From: MaximilianoTabacman Date: Tue, 20 Feb 2024 08:25:01 -0300 Subject: [PATCH 5/5] Removed unnecesary assignment on aborted transaction --- source/Sagan-GemStone/GemStoneTransaction.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/Sagan-GemStone/GemStoneTransaction.class.st b/source/Sagan-GemStone/GemStoneTransaction.class.st index ad48413..32b9b8f 100644 --- a/source/Sagan-GemStone/GemStoneTransaction.class.st +++ b/source/Sagan-GemStone/GemStoneTransaction.class.st @@ -20,7 +20,7 @@ GemStoneTransaction >> transact: aBlock [ [ result := aBlock value. System commitTransaction - ] ifCurtailed: [ result := System abortTransaction ]. + ] ifCurtailed: [ System abortTransaction ]. result ] ]