Skip to content

Commit 52246b0

Browse files
akgrant43akgrant43
committed
GtGemStoneGtCodeExporter export GtExamples, additional examples.
Basic GT example functionality is working, dependency analysis is not yet functional.
1 parent c1b1c3d commit 52246b0

15 files changed

Lines changed: 1598 additions & 93 deletions

‎src/GToolkit-GemStone-Pharo-Stubs/GsNMethod.class.st‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
"
2+
I am a Pharo-side declaration for GemStone's GsNMethod. My gsCode: methods provide compiled-method compatibility required by the gtExample framework.
3+
"
4+
Class {
5+
#name : #GsNMethod,
6+
#superclass : #Object,
7+
#category : #'GToolkit-GemStone-Pharo-Stubs'
8+
}
9+
10+
{ #category : #testing }
11+
GsNMethod >> isGTExampleMethod [
12+
<gsCode: '^ (self pragmas anySatisfy: [ :each | each isGTExamplePragma ])
13+
and: [ self numArgs = 0 ]'>
14+
^ self shouldNotImplement
15+
]
16+
17+
{ #category : #accessing }
18+
GsNMethod >> methodClass [
19+
<gsCode: '^ self inClass'>
20+
^ self shouldNotImplement
21+
]

‎src/GToolkit-GemStone-Pharo-Stubs/Metaclass3.class.st‎

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
"
2+
I am a Pharo-side declaration for GemStone's Metaclass3. My gsCode: methods provide GemStone-specific class-side compatibility required by the gtExample framework.
3+
"
4+
Class {
5+
#name : #Metaclass3,
6+
#superclass : #Object,
7+
#category : #'GToolkit-GemStone-Pharo-Stubs'
8+
}
9+
10+
{ #category : #accessing }
11+
Metaclass3 >> classSide [
12+
<gsCode: '^ self isMeta
13+
ifTrue: [ self ]
14+
ifFalse: [ self class ]'>
15+
^ self shouldNotImplement
16+
]
17+
18+
{ #category : #accessing }
19+
Metaclass3 >> gtExamples [
20+
<gsCode: '^ self gtExamplesFactory gtExamplesContained'>
21+
^ self shouldNotImplement
22+
]
23+
24+
{ #category : #accessing }
25+
Metaclass3 >> gtExamplesFactory [
26+
<gsCode: '^ self gtExamplesFactoryClass new
27+
sourceClass: self;
28+
yourself'>
29+
^ self shouldNotImplement
30+
]
31+
32+
{ #category : #accessing }
33+
Metaclass3 >> gtExamplesFactoryClass [
34+
<gsCode: '^ GtExampleFactory'>
35+
^ self shouldNotImplement
36+
]
37+
38+
{ #category : #accessing }
39+
Metaclass3 >> gtExamplesSubjects [
40+
"I return the list of subjects for examples defined on the instance side."
41+
<gsCode: '^ #()'>
42+
^ self shouldNotImplement
43+
]
44+
45+
{ #category : #testing }
46+
Metaclass3 >> includesBehavior: aBehavior [
47+
<gsCode: '^ self == aBehavior or: [ self allSuperclasses includes: aBehavior ]'>
48+
^ self shouldNotImplement
49+
]
50+
51+
{ #category : #accessing }
52+
Metaclass3 >> instanceSide [
53+
<gsCode: '^ self isMeta
54+
ifTrue: [ self thisClass ]
55+
ifFalse: [ self ]'>
56+
^ self shouldNotImplement
57+
]
58+
59+
{ #category : #testing }
60+
Metaclass3 >> isInstanceSide [
61+
<gsCode: '^ self isMeta not'>
62+
^ self shouldNotImplement
63+
]
64+
65+
{ #category : #accessing }
66+
Metaclass3 >> methods [
67+
<gsCode: '^ self selectors collect: [ :each | self compiledMethodAt: each ]'>
68+
^ self shouldNotImplement
69+
]

src/GToolkit-GemStone-Pharo/GtGemStoneLlmCodeExporter.class.st renamed to src/GToolkit-GemStone-Pharo/GtGemStoneGtCodeExporter.class.st

Lines changed: 187 additions & 36 deletions
Large diffs are not rendered by default.

‎src/GToolkit-GemStone-Pharo/GtGemStoneGtCodeExporterExamples.class.st‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
"
2+
I provide examples for the static GemStone export dependency analysis.
3+
"
4+
Class {
5+
#name : #GtGemStoneGtCodeExporterExamples,
6+
#superclass : #Object,
7+
#category : #'GToolkit-GemStone-Pharo-Examples'
8+
}
9+
10+
{ #category : #examples }
11+
GtGemStoneGtCodeExporterExamples >> exportsGtExampleGemStoneCompatibilityMethods [
12+
<gtExample>
13+
| output |
14+
output := GtGemStoneGtCodeExporter new configuredExporter asTopazString.
15+
self assert: (output includesSubstring: 'method: Metaclass3').
16+
self assert: (output includesSubstring: 'gtExamplesFactory').
17+
self assert: (output includesSubstring: 'method: GsNMethod').
18+
self assert: (output includesSubstring: 'isGTExampleMethod').
19+
self assert: (output includesSubstring: 'method: Pragma').
20+
self assert: (output includesSubstring: 'isGTExamplePragma').
21+
self assert: (output includesSubstring: 'method: GtExample').
22+
self assert: (output includesSubstring: '^ super new initialize').
23+
self assert: (output includesSubstring: 'subclass: ''Metaclass3''') not.
24+
self assert: (output includesSubstring: 'subclass: ''GsNMethod''') not.
25+
self assert: (output includesSubstring: 'subclass: ''ExecutionEnvironment''').
26+
self assert: (output includesSubstring: 'subclass: ''DefaultExecutionEnvironment''').
27+
self assert: (output includesSubstring: 'subclass: ''TestExecutionEnvironment''').
28+
self assert: (output includesSubstring: 'subclass: ''TestExecutionService''').
29+
self assert: (output includesSubstring: 'subclass: ''TestTookTooMuchTime''').
30+
self assert: (output includesSubstring: 'subclass: ''ProcessMonitorTestService''') not.
31+
self assert: (output includesSubstring: 'waitForMilliseconds: maxTimeForTest asMilliseconds').
32+
self assert: (output includesSubstring: '^ DefaultExecutionEnvironment instance runExampleEvaluator: anExampleEvaluator').
33+
self assert: (output includesSubstring: 'SessionTemps current at: #DefaultExecutionEnvironment_instance ifAbsentPut: [ self new ]').
34+
self assert: (output includesSubstring: 'ext_DefaultExecutionEnvironment_instance').
35+
self assert: (output includesSubstring: '^instance ifNil: [ instance := self new ]').
36+
self assert: (output includesSubstring: 'ext_DefaultExecutionEnvironment_runExampleEvaluator_').
37+
self assert: (output includesSubstring: 'ext_TestExecutionEnvironment_registerDefaultServices').
38+
self assert: (output includesSubstring: 'ext_TestExecutionEnvironment_watchDogLoop').
39+
self assert: (output includesSubstring: 'ext_TestExecutionEnvironment_runExampleUnderWatchdogUsingEvaluator_').
40+
self assert: (output includesSubstring: 'ext_TestExecutionEnvironment_runUnmanagedExampleEvaluator_').
41+
self assert: (output includesSubstring: 'ext_TestExecutionEnvironment_processMonitor').
42+
self assert: (output includesSubstring: 'method: TestExecutionEnvironment
43+
runUnmanagedExampleEvaluator:') not.
44+
self assert: (output includesSubstring: 'method: TestExecutionEnvironment
45+
processMonitor') not.
46+
^ output
47+
]
48+
49+
{ #category : #examples }
50+
GtGemStoneGtCodeExporterExamples >> staticAnalysisClassifiesKnownFailures [
51+
<gtExample>
52+
| exporter analysis generated stubDifferences |
53+
exporter := GtGemStoneGtCodeExporter new.
54+
analysis := exporter staticExportAnalysisForPackageNames: exporter packageNames.
55+
generated := analysis at: #generated.
56+
self assert: ((generated at: #additionalClasses) includes: GtLlmError).
57+
self assert: ((generated at: #stubClasses) includes: GtRBNamespace).
58+
self assert: ((generated at: #excludedMethods) includes: GtLClassCreationDataExtractor>>#extractSuperclassIfError:).
59+
self assert: ((generated at: #excludedMethods) includes: GtLDataView>>#documentData).
60+
self assert: ((generated at: #excludedMethods) includes: GtLMarkdown>>#commentForSmaCC).
61+
stubDifferences := (analysis at: #differences) at: #stubClasses.
62+
self assert: (stubDifferences at: #missingFromExisting) equals: (Set with: ProcessMonitorTestService).
63+
^ analysis
64+
]

‎src/GToolkit-GemStone-Pharo/GtGemStoneTopazExporter.class.st‎

Lines changed: 211 additions & 57 deletions
Large diffs are not rendered by default.

‎src/GToolkit-GemStone-Pharo/GtGemStoneTopazExporterExamples.class.st‎

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,39 @@ GtGemStoneTopazExporterExamples >> exportExcludingMethods [
6060
^ exporter
6161
]
6262

63+
{ #category : #examples }
64+
GtGemStoneTopazExporterExamples >> exportExcludingTraitOriginMethod [
65+
<gtExample>
66+
<return: #GtGemStoneTopazExporter>
67+
| exporter output |
68+
exporter := GtGemStoneTopazExporter new
69+
additionalClasses: { GtGemStoneTopazExporterTraitedFixture };
70+
excludedMethods: { TGtGemStoneTopazExporterFixture >> #traitGreeting };
71+
yourself.
72+
output := exporter asTopazString.
73+
self assert: (output includesSubstring: 'method: GtGemStoneTopazExporterTraitedFixture', String lf, 'traitGreeting') not.
74+
self assert: (output includesSubstring: 'method: GtGemStoneTopazExporterTraitedFixture', String lf, 'localGreeting').
75+
^ exporter
76+
]
77+
78+
{ #category : #examples }
79+
GtGemStoneTopazExporterExamples >> exportFlattenedTrait [
80+
<gtExample>
81+
<return: #GtGemStoneTopazExporter>
82+
| exporter output |
83+
exporter := GtGemStoneTopazExporter new
84+
additionalClasses: { GtGemStoneTopazExporterTraitedFixture. TGtGemStoneTopazExporterFixture. };
85+
yourself.
86+
output := exporter asTopazString.
87+
self assert: (exporter selectedClasses includes: GtGemStoneTopazExporterTraitedFixture).
88+
self assert: (exporter selectedClasses includes: TGtGemStoneTopazExporterFixture) not.
89+
self assert: (output includesSubstring: 'method: GtGemStoneTopazExporterTraitedFixture', String lf, 'traitGreeting').
90+
self assert: (output includesSubstring: 'TGtGemStoneTopazExporterFixture') not.
91+
self assert: (output includesSubstring: 'instVarNames: #( localValue traitValue)').
92+
self assert: (output includesSubstring: 'classInstVars: #( localClassValue traitClassSlot)').
93+
^ exporter
94+
]
95+
6396
{ #category : #examples }
6497
GtGemStoneTopazExporterExamples >> exportGsCodeMethod [
6598
<gtExample>
@@ -143,13 +176,75 @@ GtGemStoneTopazExporterExamples >> exportSuperclassBeforeSubclass [
143176
^ exporter
144177
]
145178

179+
{ #category : #examples }
180+
GtGemStoneTopazExporterExamples >> gemstoneSourceForGsCodeMethod [
181+
<gtExample>
182+
<return: #String>
183+
| method source expected |
184+
method := self class >> #gsCodeExampleMethod.
185+
source := GtGemStoneTopazExporter gemstoneSourceFor: method.
186+
expected := 'gsCodeExampleMethod
187+
"Provide an example method with the gsCode: pragma"
188+
^ self copyFrom: 1 to: 3'.
189+
self
190+
assert: source withUnixLineEndings
191+
equals: expected withUnixLineEndings.
192+
^ source
193+
]
194+
195+
{ #category : #examples }
196+
GtGemStoneTopazExporterExamples >> gemstoneSourceForNilGsCodeMethod [
197+
<gtExample>
198+
<return: #String>
199+
| method source |
200+
method := self class >> #gsCodeNilExampleMethod.
201+
source := GtGemStoneTopazExporter gemstoneSourceFor: method.
202+
self assert: source equals: method sourceCode.
203+
^ source
204+
]
205+
206+
{ #category : #examples }
207+
GtGemStoneTopazExporterExamples >> gemstoneSourceForSourceWithGsCode [
208+
<gtExample>
209+
<return: #String>
210+
| source gemstoneSource expected |
211+
source := 'example
212+
<gsCode: ''example ^ 42''>
213+
^ 1'.
214+
gemstoneSource := GtGemStoneTopazExporter gemstoneSourceForSource: source.
215+
expected := 'example
216+
example ^ 42'.
217+
self assert: gemstoneSource equals: expected.
218+
^ gemstoneSource
219+
]
220+
221+
{ #category : #examples }
222+
GtGemStoneTopazExporterExamples >> gemstoneSourceForSourceWithNilGsCode [
223+
<gtExample>
224+
<return: #String>
225+
| source gemstoneSource |
226+
source := 'example
227+
<gsCode: nil>
228+
^ 1'.
229+
gemstoneSource := GtGemStoneTopazExporter gemstoneSourceForSource: source.
230+
self assert: gemstoneSource equals: source.
231+
^ gemstoneSource
232+
]
233+
146234
{ #category : #Examples }
147235
GtGemStoneTopazExporterExamples >> gsCodeExampleMethod [
148236
"Provide an example method with the gsCode: pragma"
149237
<gsCode: '^ self copyFrom: 1 to: 3'>
150238
^ self first: 3
151239
]
152240

241+
{ #category : #'examples - support' }
242+
GtGemStoneTopazExporterExamples >> gsCodeNilExampleMethod [
243+
"Use gsCode: as an export flag while retaining this source"
244+
<gsCode: nil>
245+
^ self first: 3
246+
]
247+
153248
{ #category : #examples }
154249
GtGemStoneTopazExporterExamples >> selectPackageWithInclusionAndExclusion [
155250
<gtExample>

‎src/GToolkit-GemStone-Pharo/GtGemStoneTopazExporterTraitedFixture.class.st‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
"
2+
Fixture class used to demonstrate flattened trait export.
3+
"
4+
Class {
5+
#name : #GtGemStoneTopazExporterTraitedFixture,
6+
#superclass : #Object,
7+
#traits : 'TGtGemStoneTopazExporterFixture',
8+
#classTraits : 'TGtGemStoneTopazExporterFixture classTrait',
9+
#instVars : [
10+
'localValue'
11+
],
12+
#classInstVars : [
13+
'localClassValue'
14+
],
15+
#category : #'GToolkit-GemStone-Pharo-Examples'
16+
}
17+
18+
{ #category : #accessing }
19+
GtGemStoneTopazExporterTraitedFixture >> localGreeting [
20+
^ 'local'
21+
]

‎src/GToolkit-GemStone-Pharo/GtRsrEvaluatorAsyncPromise.class.st‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,11 @@ GtRsrEvaluatorAsyncPromise >> gtRsrEvaluatorPromise: anEvaluatorPromise [
9595
gtRsrEvaluatorPromise := anEvaluatorPromise
9696
]
9797

98+
{ #category : #accessing }
99+
GtRsrEvaluatorAsyncPromise >> gtSession [
100+
^ gemStoneSession
101+
]
102+
98103
{ #category : #testing }
99104
GtRsrEvaluatorAsyncPromise >> hasEvaluationContext [
100105
^ executionContext notNil

‎src/GToolkit-GemStone-Pharo/TGtGemStoneTopazExporterFixture.trait.st‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
"
2+
Fixture trait used by the Topaz exporter examples.
3+
"
4+
Trait {
5+
#name : #TGtGemStoneTopazExporterFixture,
6+
#instVars : [
7+
'traitValue'
8+
],
9+
#classInstVars : [
10+
'traitClassSlot'
11+
],
12+
#category : #'GToolkit-GemStone-Pharo-Examples'
13+
}
14+
15+
{ #category : #accessing }
16+
TGtGemStoneTopazExporterFixture >> traitGreeting [
17+
^ 'from trait'
18+
]
19+
20+
{ #category : #accessing }
21+
TGtGemStoneTopazExporterFixture >> traitValue [
22+
^ traitValue
23+
]

0 commit comments

Comments
 (0)