From 3ad1b507ef4ecdb330610f79110f048077a9c3ae Mon Sep 17 00:00:00 2001 From: Alistair Grant Date: Wed, 30 Apr 2025 09:18:13 +0200 Subject: [PATCH 1/2] Add Proxy caching (WIP) --- .../GtProxyAbstractCacheStrategy.class.st | 10 ++++ ...xplicitSelectorsMatchingCondition.class.st | 58 +++++++++++++++++++ .../GtProxyCacheMatchingCondition.class.st | 10 ++++ .../GtProxyCacheNoMatchingCondition.class.st | 10 ++++ .../GtProxyCacheStaticStorage.class.st | 13 +++++ src/Gt4PharoLink/GtProxyCacheStorage.class.st | 10 ++++ .../GtProxyCacheStrategy.class.st | 52 +++++++++++++++++ ...heUnarySelectorsMatchingCondition.class.st | 10 ++++ .../GtProxyNoCacheStrategy.class.st | 15 +++++ 9 files changed, 188 insertions(+) create mode 100644 src/Gt4PharoLink/GtProxyAbstractCacheStrategy.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheNoMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheStorage.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheStrategy.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheUnarySelectorsMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st diff --git a/src/Gt4PharoLink/GtProxyAbstractCacheStrategy.class.st b/src/Gt4PharoLink/GtProxyAbstractCacheStrategy.class.st new file mode 100644 index 00000000..f6e79a6d --- /dev/null +++ b/src/Gt4PharoLink/GtProxyAbstractCacheStrategy.class.st @@ -0,0 +1,10 @@ +Class { + #name : #GtProxyAbstractCacheStrategy, + #superclass : #Object, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyAbstractCacheStrategy >> send: aMessage withComputation: aBlockClosure [ + ^ self subclassResponsibility +] diff --git a/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st new file mode 100644 index 00000000..7d8f4fc6 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st @@ -0,0 +1,58 @@ +Class { + #name : #GtProxyCacheExplicitSelectorsMatchingCondition, + #superclass : #GtProxyCacheMatchingCondition, + #instVars : [ + 'includedSelectors', + 'excludedSelectors', + 'excludedPatterns', + 'includedPatterns' + ], + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheExplicitSelectorsMatchingCondition >> appliesToMessage: aMessage [ + "Excludes have higher priority than includes" + | selector | + + ((excludedSelectors includes: selector) or: + [ excludedPatterns anyMatch: selector ]) ifTrue: + [ ^ false ]. + selector := aMessage selector. + + ^ false +] + +{ #category : #'as yet unclassified' } +GtProxyCacheExplicitSelectorsMatchingCondition >> excludePattern: aRegexString [ + + excludedPatterns add: aRegexString +] + +{ #category : #'as yet unclassified' } +GtProxyCacheExplicitSelectorsMatchingCondition >> excludeSelector: aSymbol [ + + excludedSelectors add: aSymbol +] + +{ #category : #'as yet unclassified' } +GtProxyCacheExplicitSelectorsMatchingCondition >> includePattern: aRegexString [ + + includedPatterns add: aRegexString +] + +{ #category : #'as yet unclassified' } +GtProxyCacheExplicitSelectorsMatchingCondition >> includeSelector: aSymbol [ + + includedSelectors add: aSymbol +] + +{ #category : #initialization } +GtProxyCacheExplicitSelectorsMatchingCondition >> initialize [ + + super initialize. + includedSelectors := Set new. + excludedSelectors := Set new. + includedPatterns := Set new. + excludedPatterns := Set new. +] diff --git a/src/Gt4PharoLink/GtProxyCacheMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheMatchingCondition.class.st new file mode 100644 index 00000000..6793acfd --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheMatchingCondition.class.st @@ -0,0 +1,10 @@ +Class { + #name : #GtProxyCacheMatchingCondition, + #superclass : #Object, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheMatchingCondition >> appliesToMessage: aMessage [ + ^ self subclassResponsibility +] diff --git a/src/Gt4PharoLink/GtProxyCacheNoMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheNoMatchingCondition.class.st new file mode 100644 index 00000000..a1246a4c --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheNoMatchingCondition.class.st @@ -0,0 +1,10 @@ +Class { + #name : #GtProxyCacheNoMatchingCondition, + #superclass : #GtProxyCacheMatchingCondition, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheNoMatchingCondition >> appliesToMessage: aMessage [ + ^ false +] diff --git a/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st b/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st new file mode 100644 index 00000000..6a971402 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st @@ -0,0 +1,13 @@ +Class { + #name : #GtProxyCacheStaticStorage, + #superclass : #GtProxyCacheStorage, + #instVars : [ + 'cachedResults' + ], + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheStaticStorage >> at: aKey ifAbsentPut: aBlockClosure [ + ^ cachedResults at: aKey ifAbsentPut: aBlockClosure +] diff --git a/src/Gt4PharoLink/GtProxyCacheStorage.class.st b/src/Gt4PharoLink/GtProxyCacheStorage.class.st new file mode 100644 index 00000000..ac3544de --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheStorage.class.st @@ -0,0 +1,10 @@ +Class { + #name : #GtProxyCacheStorage, + #superclass : #Object, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheStorage >> at: aKey ifAbsentPut: aBlockClosure [ + self subclassResponsibility +] diff --git a/src/Gt4PharoLink/GtProxyCacheStrategy.class.st b/src/Gt4PharoLink/GtProxyCacheStrategy.class.st new file mode 100644 index 00000000..03f9a5de --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheStrategy.class.st @@ -0,0 +1,52 @@ +Class { + #name : #GtProxyCacheStrategy, + #superclass : #GtProxyAbstractCacheStrategy, + #instVars : [ + 'storage', + 'matchingCondition' + ], + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> appliesToMessage: aMessage [ + ^ matchingCondition appliesToMessage: aMessage +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> cachedValueFor: aMessage ifAbsentPut: aBlockClosure [ + ^ storage + at: (self storageKeyFor: aMessage) + ifAbsentPut: aBlockClosure +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> initialize [ + super initialize. + + storage := GtProxyCacheStaticStorage new. + matchingCondition := GtProxyCacheNoMatchingCondition new. +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> matchAllUnarySelectors [ + matchingCondition := GtProxyCacheUnarySelectorsMatchingCondition new +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> matchUnarySelectors: aListOfSelectors [ + matchingCondition := GtProxyCacheUnarySelectorsMatchingCondition new +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> send: aMessage withComputation: aBlockClosure [ + (self appliesToMessage: aMessage) + ifFalse: [ ^ aBlockClosure value ]. + + ^ self cachedValueFor: aMessage ifAbsentPut: aBlockClosure +] + +{ #category : #'as yet unclassified' } +GtProxyCacheStrategy >> storageKeyFor: aMessage [ + ^ aMessage selector +] diff --git a/src/Gt4PharoLink/GtProxyCacheUnarySelectorsMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheUnarySelectorsMatchingCondition.class.st new file mode 100644 index 00000000..4f295ce1 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheUnarySelectorsMatchingCondition.class.st @@ -0,0 +1,10 @@ +Class { + #name : #GtProxyCacheUnarySelectorsMatchingCondition, + #superclass : #GtProxyCacheMatchingCondition, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheUnarySelectorsMatchingCondition >> appliesToMessage: aMessage [ + ^ aMessage selector isUnary +] diff --git a/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st b/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st new file mode 100644 index 00000000..e0ea1246 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st @@ -0,0 +1,15 @@ +Class { + #name : #GtProxyNoCacheStrategy, + #superclass : #GtProxyAbstractCacheStrategy, + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyNoCacheStrategy >> appliesToMessage: aMessage [ + ^ false +] + +{ #category : #'as yet unclassified' } +GtProxyNoCacheStrategy >> send: aMessage withComputation: aBlockClosure [ + ^ aBlockClosure value +] From a28ce2d27295f43c0f94d09494bcc53d78110a98 Mon Sep 17 00:00:00 2001 From: Alistair Grant Date: Wed, 30 Apr 2025 12:38:38 +0200 Subject: [PATCH 2/2] Add proxy cache (GtProxyCacheStrategy) --- ...xplicitSelectorsMatchingCondition.class.st | 58 --------- ...oxyCacheMatchingConditionExamples.class.st | 115 ++++++++++++++++++ ...ecifiedSelectorsMatchingCondition.class.st | 78 ++++++++++++ .../GtProxyCacheStaticStorage.class.st | 7 ++ .../GtProxyCacheStrategy.class.st | 22 +++- .../GtProxyCacheStrategyExamples.class.st | 65 ++++++++++ .../GtProxyNoCacheStrategy.class.st | 2 +- .../GtProxyNoCacheStrategyExamples.class.st | 18 +++ 8 files changed, 300 insertions(+), 65 deletions(-) delete mode 100644 src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheMatchingConditionExamples.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheSpecifiedSelectorsMatchingCondition.class.st create mode 100644 src/Gt4PharoLink/GtProxyCacheStrategyExamples.class.st create mode 100644 src/Gt4PharoLink/GtProxyNoCacheStrategyExamples.class.st diff --git a/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st deleted file mode 100644 index 7d8f4fc6..00000000 --- a/src/Gt4PharoLink/GtProxyCacheExplicitSelectorsMatchingCondition.class.st +++ /dev/null @@ -1,58 +0,0 @@ -Class { - #name : #GtProxyCacheExplicitSelectorsMatchingCondition, - #superclass : #GtProxyCacheMatchingCondition, - #instVars : [ - 'includedSelectors', - 'excludedSelectors', - 'excludedPatterns', - 'includedPatterns' - ], - #category : #'Gt4PharoLink-Cache' -} - -{ #category : #'as yet unclassified' } -GtProxyCacheExplicitSelectorsMatchingCondition >> appliesToMessage: aMessage [ - "Excludes have higher priority than includes" - | selector | - - ((excludedSelectors includes: selector) or: - [ excludedPatterns anyMatch: selector ]) ifTrue: - [ ^ false ]. - selector := aMessage selector. - - ^ false -] - -{ #category : #'as yet unclassified' } -GtProxyCacheExplicitSelectorsMatchingCondition >> excludePattern: aRegexString [ - - excludedPatterns add: aRegexString -] - -{ #category : #'as yet unclassified' } -GtProxyCacheExplicitSelectorsMatchingCondition >> excludeSelector: aSymbol [ - - excludedSelectors add: aSymbol -] - -{ #category : #'as yet unclassified' } -GtProxyCacheExplicitSelectorsMatchingCondition >> includePattern: aRegexString [ - - includedPatterns add: aRegexString -] - -{ #category : #'as yet unclassified' } -GtProxyCacheExplicitSelectorsMatchingCondition >> includeSelector: aSymbol [ - - includedSelectors add: aSymbol -] - -{ #category : #initialization } -GtProxyCacheExplicitSelectorsMatchingCondition >> initialize [ - - super initialize. - includedSelectors := Set new. - excludedSelectors := Set new. - includedPatterns := Set new. - excludedPatterns := Set new. -] diff --git a/src/Gt4PharoLink/GtProxyCacheMatchingConditionExamples.class.st b/src/Gt4PharoLink/GtProxyCacheMatchingConditionExamples.class.st new file mode 100644 index 00000000..4e08f13a --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheMatchingConditionExamples.class.st @@ -0,0 +1,115 @@ +Class { + #name : #GtProxyCacheMatchingConditionExamples, + #superclass : #Object, + #traits : 'TAssertable', + #classTraits : 'TAssertable classTrait', + #category : #'Gt4PharoLink-Examples' +} + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> noMatchingCondition [ + + + self deny: (GtProxyCacheNoMatchingCondition new appliesToMessage: #anything) +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> specificSelectorsMatchingConditionCachesFoo [ + + | matchingCondition | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new. + matchingCondition includeSelector: #foo. + self assert: (matchingCondition appliesToMessage: (Message + selector: #foo)). + self deny: (matchingCondition appliesToMessage: (Message + selector: #bar)). + ^ matchingCondition +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> specificSelectorsMatchingConditionCachesFooPattern [ + + | matchingCondition | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new. + matchingCondition includePattern: 'foo.*'. + self assert: (matchingCondition appliesToMessage: (Message + selector: #foo)). + self assert: (matchingCondition appliesToMessage: (Message + selector: #foobar)). + self deny: (matchingCondition appliesToMessage: (Message + selector: #barfoo)). + ^ matchingCondition +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> specificSelectorsMatchingConditionCachesFooPatternNotFoobPattern [ + + | matchingCondition | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new. + matchingCondition + includePattern: 'foo.*'; + excludePattern: 'foob.*'. + self assert: (matchingCondition appliesToMessage: (Message + selector: #foo)). + self assert: (matchingCondition appliesToMessage: (Message + selector: #fooey)). + self deny: (matchingCondition appliesToMessage: (Message + selector: #foobar)). + ^ matchingCondition +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> specificSelectorsMatchingConditionCachesFooPatternNotFoobar [ + + | matchingCondition | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new. + matchingCondition + includePattern: 'foo.*'; + excludeSelector: #foobar. + self assert: (matchingCondition appliesToMessage: (Message + selector: #foo)). + self deny: (matchingCondition appliesToMessage: (Message + selector: #foobar)). + ^ matchingCondition +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> specificSelectorsMatchingConditionNoneIncluded [ + + + self deny: (GtProxyCacheSpecifiedSelectorsMatchingCondition new appliesToMessage: (Message + selector: #foo)) +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> unaryMatchingConditionBinarySelector [ + + + self deny: (GtProxyCacheUnarySelectorsMatchingCondition new + appliesToMessage: (Message + selector: #+ + argument: nil)) +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> unaryMatchingConditionKeywordSelector [ + + + self deny: (GtProxyCacheUnarySelectorsMatchingCondition new + appliesToMessage: (Message + selector: #foo: + argument: nil)) +] + +{ #category : #examples } +GtProxyCacheMatchingConditionExamples >> unaryMatchingConditionUnarySelector [ + + + self assert: (GtProxyCacheUnarySelectorsMatchingCondition new + appliesToMessage: (Message + selector: #foo)) +] diff --git a/src/Gt4PharoLink/GtProxyCacheSpecifiedSelectorsMatchingCondition.class.st b/src/Gt4PharoLink/GtProxyCacheSpecifiedSelectorsMatchingCondition.class.st new file mode 100644 index 00000000..6f9d20a9 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheSpecifiedSelectorsMatchingCondition.class.st @@ -0,0 +1,78 @@ +Class { + #name : #GtProxyCacheSpecifiedSelectorsMatchingCondition, + #superclass : #GtProxyCacheMatchingCondition, + #instVars : [ + 'includedSelectors', + 'excludedSelectors', + 'excludedPatterns', + 'includedPatterns' + ], + #category : #'Gt4PharoLink-Cache' +} + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> appliesToMessage: aMessage [ + "Answer a boolean indicating whether the specified message should have its result cached. + Only included selectors are cached. + Included regex patterns may be overridden with excluded selectors or patterns." + | selector | + + selector := aMessage selector. + ((excludedSelectors isNotNil and: [ excludedSelectors includes: selector ]) or: + [ excludedPatterns isNotNil and: [ excludedPatterns anySatisfy: [ :pattern | selector matchesRegex: pattern ] ] ]) ifTrue: + [ ^ false ]. + ^ (includedSelectors isNotNil and: [ includedSelectors includes: selector ]) or: + [ includedPatterns isNotNil and: [ includedPatterns anySatisfy: [ :pattern | selector matchesRegex: pattern ] ] ] +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> excludePattern: aRegexString [ + + excludedPatterns ifNil: [ excludedPatterns := Set new ]. + excludedPatterns add: aRegexString +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> excludeSelector: aSymbol [ + + excludedSelectors ifNil: [ excludedSelectors := Set new ]. + excludedSelectors add: aSymbol +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> excludeSelectors: aCollectionOfSymbols [ + + excludedSelectors ifNil: [ excludedSelectors := Set new ]. + excludedSelectors addAll: aCollectionOfSymbols +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> includePattern: aRegexString [ + + includedPatterns ifNil: [ includedPatterns := Set new ]. + includedPatterns add: aRegexString +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> includeSelector: aSymbol [ + + includedSelectors ifNil: [ includedSelectors := Set new ]. + includedSelectors add: aSymbol +] + +{ #category : #'as yet unclassified' } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> includeSelectors: aCollectionOfSymbols [ + + includedSelectors ifNil: [ includedSelectors := Set new ]. + includedSelectors addAll: aCollectionOfSymbols +] + +{ #category : #initialization } +GtProxyCacheSpecifiedSelectorsMatchingCondition >> initialize [ + + super initialize. + includedSelectors := Set new. + excludedSelectors := Set new. + includedPatterns := Set new. + excludedPatterns := Set new. +] diff --git a/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st b/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st index 6a971402..267482fd 100644 --- a/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st +++ b/src/Gt4PharoLink/GtProxyCacheStaticStorage.class.st @@ -11,3 +11,10 @@ Class { GtProxyCacheStaticStorage >> at: aKey ifAbsentPut: aBlockClosure [ ^ cachedResults at: aKey ifAbsentPut: aBlockClosure ] + +{ #category : #'as yet unclassified' } +GtProxyCacheStaticStorage >> initialize [ + + super initialize. + cachedResults := Dictionary new. +] diff --git a/src/Gt4PharoLink/GtProxyCacheStrategy.class.st b/src/Gt4PharoLink/GtProxyCacheStrategy.class.st index 03f9a5de..3a81b9df 100644 --- a/src/Gt4PharoLink/GtProxyCacheStrategy.class.st +++ b/src/Gt4PharoLink/GtProxyCacheStrategy.class.st @@ -8,19 +8,19 @@ Class { #category : #'Gt4PharoLink-Cache' } -{ #category : #'as yet unclassified' } +{ #category : #testing } GtProxyCacheStrategy >> appliesToMessage: aMessage [ ^ matchingCondition appliesToMessage: aMessage ] -{ #category : #'as yet unclassified' } +{ #category : #private } GtProxyCacheStrategy >> cachedValueFor: aMessage ifAbsentPut: aBlockClosure [ ^ storage at: (self storageKeyFor: aMessage) ifAbsentPut: aBlockClosure ] -{ #category : #'as yet unclassified' } +{ #category : #initialization } GtProxyCacheStrategy >> initialize [ super initialize. @@ -28,16 +28,26 @@ GtProxyCacheStrategy >> initialize [ matchingCondition := GtProxyCacheNoMatchingCondition new. ] -{ #category : #'as yet unclassified' } +{ #category : #initialization } GtProxyCacheStrategy >> matchAllUnarySelectors [ matchingCondition := GtProxyCacheUnarySelectorsMatchingCondition new ] -{ #category : #'as yet unclassified' } +{ #category : #initialization } GtProxyCacheStrategy >> matchUnarySelectors: aListOfSelectors [ matchingCondition := GtProxyCacheUnarySelectorsMatchingCondition new ] +{ #category : #accessing } +GtProxyCacheStrategy >> matchingCondition [ + ^ matchingCondition +] + +{ #category : #accessing } +GtProxyCacheStrategy >> matchingCondition: anObject [ + matchingCondition := anObject +] + { #category : #'as yet unclassified' } GtProxyCacheStrategy >> send: aMessage withComputation: aBlockClosure [ (self appliesToMessage: aMessage) @@ -46,7 +56,7 @@ GtProxyCacheStrategy >> send: aMessage withComputation: aBlockClosure [ ^ self cachedValueFor: aMessage ifAbsentPut: aBlockClosure ] -{ #category : #'as yet unclassified' } +{ #category : #private } GtProxyCacheStrategy >> storageKeyFor: aMessage [ ^ aMessage selector ] diff --git a/src/Gt4PharoLink/GtProxyCacheStrategyExamples.class.st b/src/Gt4PharoLink/GtProxyCacheStrategyExamples.class.st new file mode 100644 index 00000000..61169e06 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyCacheStrategyExamples.class.st @@ -0,0 +1,65 @@ +Class { + #name : #GtProxyCacheStrategyExamples, + #superclass : #Object, + #traits : 'TAssertable', + #classTraits : 'TAssertable classTrait', + #category : #'Gt4PharoLink-Examples' +} + +{ #category : #examples } +GtProxyCacheStrategyExamples >> cacheForMatchingSelectors [ + + | matchingCondition cache computation result1 result2 message | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new + includeSelectors: #(#foo1 #foo2). + cache := GtProxyCacheStrategy new + matchingCondition: matchingCondition. + computation := [ :x | x + 1 ]. + message := Message selector: #foo1. + + "First call should compute" + result1 := cache send: message withComputation: [ computation value: 41 ]. + "Second call with same selector should get cached value, computation block is not evaluated" + result2 := cache send: message withComputation: [ self error: 'Should not be called' ]. + self assert: result1 equals: 42. + self assert: result2 equals: 42. + ^ cache +] + +{ #category : #examples } +GtProxyCacheStrategyExamples >> cacheSpecifiedSelector [ + "Create and test caching behavior with assertions" + + | cache message result1 result2 | + + cache := GtProxyCacheStrategy new. + cache matchingCondition: (GtProxyCacheSpecifiedSelectorsMatchingCondition new includeSelectors: #(#foo1 #foo2)). + + message := Message selector: #foo1. + result1 := cache send: message withComputation: [ 'computed value!' ]. + result2 := cache send: message withComputation: [ 'should not be used' ]. + + self assert: result1 equals: 'computed value!'. + self assert: result2 equals: 'computed value!'. +] + +{ #category : #examples } +GtProxyCacheStrategyExamples >> noCacheForNonMatchingSelectors [ + + | matchingCondition cache callCount result1 result2 message | + + matchingCondition := GtProxyCacheSpecifiedSelectorsMatchingCondition new + includeSelectors: #(#foo1 #foo2). + cache := GtProxyCacheStrategy new + matchingCondition: matchingCondition. + callCount := 0. + message := Message selector: #bar. + + result1 := cache send: message withComputation: [ callCount := callCount + 1. 40 ]. + result2 := cache send: message withComputation: [ callCount := callCount + 1. 40 ]. + self assert: callCount equals: 2. + self assert: result1 equals: 40. + self assert: result2 equals: 40. + ^ cache +] diff --git a/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st b/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st index e0ea1246..daf835a9 100644 --- a/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st +++ b/src/Gt4PharoLink/GtProxyNoCacheStrategy.class.st @@ -9,7 +9,7 @@ GtProxyNoCacheStrategy >> appliesToMessage: aMessage [ ^ false ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GtProxyNoCacheStrategy >> send: aMessage withComputation: aBlockClosure [ ^ aBlockClosure value ] diff --git a/src/Gt4PharoLink/GtProxyNoCacheStrategyExamples.class.st b/src/Gt4PharoLink/GtProxyNoCacheStrategyExamples.class.st new file mode 100644 index 00000000..f7349929 --- /dev/null +++ b/src/Gt4PharoLink/GtProxyNoCacheStrategyExamples.class.st @@ -0,0 +1,18 @@ +Class { + #name : #GtProxyNoCacheStrategyExamples, + #superclass : #Object, + #category : #'Gt4PharoLink-Examples' +} + +{ #category : #examples } +GtProxyNoCacheStrategyExamples >> sendWithComputation [ + + | strategy firstResult secondResult | + + strategy := GtProxyNoCacheStrategy new. + firstResult := strategy send: #foo withComputation: [ 42 ]. + secondResult := strategy send: #foo withComputation: [ 4 + 3 ]. + self assert: firstResult equals: 42. + self assert: secondResult equals: 7. + ^ strategy +]