Skip to content

Commit dca44a9

Browse files
akgrant43akgrant43
committed
GemStone compatibility
1 parent 992577f commit dca44a9

16 files changed

Lines changed: 121 additions & 62 deletions

‎src/GToolkit-Examples-Dummies/GtDummyExampleWithTimeout.class.st‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
"
2+
I provide short and long running examples for GemStone timeout acceptance checks.
3+
"
4+
Class {
5+
#name : #GtDummyExampleWithTimeout,
6+
#superclass : #Object,
7+
#classVars : [
8+
'CleanupCount'
9+
],
10+
#category : #'GToolkit-Examples-Dummies'
11+
}
12+
13+
{ #category : #accessing }
14+
GtDummyExampleWithTimeout class >> cleanupCount [
15+
^ CleanupCount ifNil: [ 0 ]
16+
]
17+
18+
{ #category : #accessing }
19+
GtDummyExampleWithTimeout class >> resetCleanupCount [
20+
CleanupCount := 0
21+
]
22+
23+
{ #category : #examples }
24+
GtDummyExampleWithTimeout >> defaultLimitExample [
25+
<gtExample>
26+
^ true
27+
]
28+
29+
{ #category : #examples }
30+
GtDummyExampleWithTimeout >> fastExample [
31+
<gtExample>
32+
<timeLimit: 1000>
33+
^ true
34+
]
35+
36+
{ #category : #private }
37+
GtDummyExampleWithTimeout >> recordCleanup [
38+
CleanupCount := self class cleanupCount + 1
39+
]
40+
41+
{ #category : #examples }
42+
GtDummyExampleWithTimeout >> slowExample [
43+
<gtExample>
44+
<timeLimit: 100>
45+
<noTest>
46+
(Delay forMilliseconds: 300) wait.
47+
^ true
48+
]
49+
50+
{ #category : #examples }
51+
GtDummyExampleWithTimeout >> slowWithAfterExample [
52+
<gtExample>
53+
<timeLimit: 100>
54+
<after: #recordCleanup>
55+
<noTest>
56+
(Delay forMilliseconds: 300) wait.
57+
^ true
58+
]

‎src/GToolkit-Examples-Dummies/GtDummyExamplesWithGlobalSubjects.class.st‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ GtDummyExamplesWithGlobalSubjects class >> classSideSubjects1 [
99
<gtExample>
1010

1111
self assert: self gtExampleRuntimeContext example subjects first class equals: GtExampleClassSubject.
12-
self assert: self gtExampleRuntimeContext example subjects first theClassName equals: 'GtDummyExamplesWithGlobalSubjects'.
12+
self assert: self gtExampleRuntimeContext example subjects first theClassName asString equals: 'GtDummyExamplesWithGlobalSubjects'.
1313
self assert: self gtExampleRuntimeContext example subjects first theClass equals: GtDummyExamplesWithGlobalSubjects.
1414
self assert: self gtExampleRuntimeContext example subjects first exists.
1515

@@ -21,7 +21,7 @@ GtDummyExamplesWithGlobalSubjects class >> classSideSubjects2 [
2121
<gtExample>
2222

2323
self assert: self gtExampleRuntimeContext example subjects first class equals: GtExampleClassSubject.
24-
self assert: self gtExampleRuntimeContext example subjects first theClassName equals: 'GtDummyExamplesWithGlobalSubjects'.
24+
self assert: self gtExampleRuntimeContext example subjects first theClassName asString equals: 'GtDummyExamplesWithGlobalSubjects'.
2525
self assert: self gtExampleRuntimeContext example subjects first theClass equals: GtDummyExamplesWithGlobalSubjects.
2626
self assert: self gtExampleRuntimeContext example subjects first exists.
2727

‎src/GToolkit-Examples/CurrentExecutionEnvironment.extension.st‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ Extension { #name : #CurrentExecutionEnvironment }
22

33
{ #category : #'*GToolkit-Examples-Core' }
44
CurrentExecutionEnvironment class >> runExampleEvaluator: anExampleEvaluator [
5-
5+
<gsCode: '^ DefaultExecutionEnvironment instance runExampleEvaluator: anExampleEvaluator'>
66
^ self value runExampleEvaluator: anExampleEvaluator
77
]
88

‎src/GToolkit-Examples/DefaultExecutionEnvironment.extension.st‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,9 @@ DefaultExecutionEnvironment >> runExampleEvaluator: anExampleEvaluator [
55

66
| testEnv exampleResult |
77
testEnv := TestExecutionEnvironment new.
8-
98
exampleResult := nil.
109
testEnv beActiveDuring: [
1110
exampleResult := testEnv runExampleEvaluator: anExampleEvaluator ].
12-
1311
^ exampleResult
1412
]
1513

‎src/GToolkit-Examples/Exception.extension.st‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ Extension { #name : #Exception }
44
Exception >> isGtExampleFailure [
55
"Answer a boolean indicating whether the receiver is considered to be an example failure, as opposed to an error.
66
There are multiple implementers of #assert:description: that return different exceptions, thus the exception class can't be counted on to determine what is a failure."
7+
<gsCode: nil>
78

89
^ false
910
]

‎src/GToolkit-Examples/GtClassExampleGroup.class.st‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ GtClassExampleGroup >> exampleClass: aClass [
3737
{ #category : #'private - serialization' }
3838
GtClassExampleGroup >> exampleClassName [
3939

40-
^ exampleClass ifNotNil: #name
40+
^ exampleClass ifNotNil: [ :aClass | aClass name ]
4141
]
4242

4343
{ #category : #'private - serialization' }

‎src/GToolkit-Examples/GtExample.class.st‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -137,6 +137,7 @@ GtExample >> debugger [
137137

138138
{ #category : #accessing }
139139
GtExample >> defaultTimeLimit [
140+
<gsCode: '^ Duration seconds: 60'>
140141
^ 1 minute
141142
]
142143

@@ -656,8 +657,8 @@ GtExample >> timeLimit [
656657
GtExample >> timeLimit: milliSecondsValue [
657658
<gtExamplePragma>
658659
<description: 'The timeout for the example in milliseconds'>
659-
660-
timeLimit := milliSecondsValue milliSeconds
660+
<gsCode: '^ timeLimit := Duration seconds: milliSecondsValue / 1000'>
661+
timeLimit := milliSecondsValue milliSeconds
661662
]
662663

663664
{ #category : #'accessing-dynamic' }

‎src/GToolkit-Examples/GtExampleClassResolver.class.st‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,8 @@ GtExampleClassResolver >> resolveByName [
4848

4949
{ #category : #private }
5050
GtExampleClassResolver >> theClass [
51-
^ self theClassName isClass
51+
<gsCode: '^ self theClassName isClass ifTrue: [ self theClassName ] ifFalse: [ System myUserProfile symbolList objectNamed: self theClassName asSymbol ]'>
52+
^ self theClassName isClass
5253
ifTrue: [ self theClassName ]
5354
ifFalse: [ Smalltalk classNamed: self theClassName asString ]
5455
]

‎src/GToolkit-Examples/GtExampleDependenciesResolver.class.st‎

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -62,24 +62,24 @@ GtExampleDependenciesResolver >> initialize [
6262
GtExampleExternalDependencyResolver new }
6363
]
6464

65-
{ #category : #actions }
65+
{ #category : #resolving }
6666
GtExampleDependenciesResolver >> resolveDependenciesForExample: anExample [
67+
<gsCode: '"GemStone does not provide the Pharo AST protocol used by the standard resolver yet."
68+
^ OrderedCollection new'>
6769
| exampleDependencies |
68-
70+
6971
exampleDependencies := OrderedCollection new.
70-
anExample methodDo: [ :aMethod |
71-
aMethod ast nodesDo: [ :aNode |
72-
self
73-
withDependencyExampleFrom: aNode
74-
fromMethod: aMethod
75-
forOriginalExample: anExample
76-
ifPresentDo: [ :possibleExampleDependency |
77-
exampleDependencies
78-
detect: [ :anotherExample |
79-
anotherExample = possibleExampleDependency ]
80-
ifNone: [
81-
exampleDependencies add: possibleExampleDependency ] ] ] ].
82-
72+
anExample methodDo: [ :aMethod |
73+
aMethod ast nodesDo: [ :aNode |
74+
self
75+
withDependencyExampleFrom: aNode
76+
fromMethod: aMethod
77+
forOriginalExample: anExample
78+
ifPresentDo: [ :possibleExampleDependency |
79+
exampleDependencies
80+
detect: [ :anotherExample | anotherExample = possibleExampleDependency ]
81+
ifNone: [ exampleDependencies add: possibleExampleDependency ] ] ] ].
82+
8383
^ exampleDependencies
8484
]
8585

‎src/GToolkit-Examples/GtExampleEvaluator.class.st‎

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -119,14 +119,8 @@ GtExampleEvaluator >> processAfterMethodFor: anExample withEvaluationContext: an
119119
{ #category : #public }
120120
GtExampleEvaluator >> result [
121121
<return: #GtExampleResult>
122-
self
123-
do: [ result := self runUnmanaged ]
124-
on: GtExampleResult signalableExceptions
125-
do: [ :anException |
126-
(self class startMcpServerFor: anException) ifTrue:
127-
[ self startMcpServerWith: anException ].
128-
result := (self newResultFor: self example)
129-
exampleException: (GtSystemUtility freeze: anException) ].
122+
<gsCode: 'self do: [ result := self runManaged ] on: GtExampleResult signalableExceptions do: [ :anException | result := (self newResultFor: self example) exampleException: (GtSystemUtility freeze: anException) ]. ^ result'>
123+
self do: [ result := self runUnmanaged ] on: GtExampleResult signalableExceptions do: [ :anException | (self class startMcpServerFor: anException) ifTrue: [ self startMcpServerWith: anException ]. result := (self newResultFor: self example) exampleException: (GtSystemUtility freeze: anException) ].
130124
^ result
131125
]
132126

@@ -138,9 +132,10 @@ GtExampleEvaluator >> runManaged [
138132

139133
{ #category : #public }
140134
GtExampleEvaluator >> runUnmanaged [
141-
<return: #GtExampleResult>
142-
143135
"The ideal case would be to updade the example runner to use runManaged"
136+
<return: #GtExampleResult>
137+
<gsCode: '^ self value'>
138+
144139
^ CurrentExecutionEnvironment runUnmanagedExampleEvaluator: self
145140
]
146141

0 commit comments

Comments
 (0)