Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
stinst: Fix support for keyword attributes
2014-04-02 Gwenael Casaccio <gwenael.casaccio@gmail.com>

	* STCompiler.st: Support keyword attributes.
	* STCompilerTests.st: Test for method attributes.
  • Loading branch information
Gwenael Casaccio authored and zecke committed Apr 10, 2014
1 parent c916f68 commit 9b6190d
Show file tree
Hide file tree
Showing 3 changed files with 78 additions and 12 deletions.
5 changes: 5 additions & 0 deletions packages/stinst/parser/ChangeLog
@@ -1,3 +1,8 @@
2014-04-02 Gwenael Casaccio <gwenael.casaccio@gmail.com>

* STCompiler.st: Support keyword attributes.
* STCompilerTests.st: Test for method attributes.

2014-02-07 Holger Hans Peter Freyther <holger@moiji-mobile.com>

* GSTParserTests.st: Remove installed classes at the end.
Expand Down
26 changes: 15 additions & 11 deletions packages/stinst/parser/STCompiler.st
Expand Up @@ -984,17 +984,21 @@ indexed'' bytecode. The resulting stream is
selectorBuilder := WriteStream on: String new.
arguments := WriteStream on: Array new.
currentToken := self scanTokenFrom: scanner.
[currentToken isBinary and: [currentToken value == #>]] whileFalse:
[currentToken isKeyword
ifFalse: [^self compileError: 'keyword expected in method attribute'].
selectorBuilder nextPutAll: currentToken value.
argParser := RBParser new.
argParser errorBlock: parser errorBlock.
argParser scanner: scanner.
node := argParser parseBinaryMessageNoGreater.
node := RBSequenceNode statements: {node}.
arguments nextPut: (self class evaluate: node parser: argParser).
currentToken := argParser currentToken].
currentToken isIdentifier
ifTrue: [ (self scanTokenFrom: scanner) value == #> ifFalse: [^self compileError: 'method attributes must end with ''>'''].
selectorBuilder nextPutAll: currentToken value. ]
ifFalse: [
[currentToken isBinary and: [currentToken value == #>]] whileFalse: [
currentToken isKeyword
ifFalse: [^self compileError: 'keyword expected in method attribute'].
selectorBuilder nextPutAll: currentToken value.
argParser := RBParser new.
argParser errorBlock: parser errorBlock.
argParser scanner: scanner.
node := argParser parseBinaryMessageNoGreater.
node := RBSequenceNode statements: {node}.
arguments nextPut: (self class evaluate: node parser: argParser).
currentToken := argParser currentToken]].
selector := selectorBuilder contents asSymbol.
^Message selector: selector arguments: arguments contents
]
Expand Down
59 changes: 58 additions & 1 deletion packages/stinst/parser/STCompilerTests.st
Expand Up @@ -38,7 +38,32 @@ Object subclass: CompilerDoubleName [
| one two three |
<category: ''bla''>
]'


]

attributes [
^ '
Namespace current: (Smalltalk addSubspace: #CompilerAttributes).
Object subclass: CAttributes [
foo1 [
<xork>
]
foo2 [
<bar: 123 foo: 234>
]
foo3 [
| bla two |
<bar: 123 foo: 234>
]
foo4 [
<bar: 123 foo: 234>
| bla two |
|
]'

]

testPoolResolution [
Expand All @@ -54,4 +79,36 @@ Object subclass: CompilerDoubleName [
self assert: (CompilerDoubleName includesGlobalNamed: #CompilerDoubleName).
self assert: ((Smalltalk at: #CompilerDoubleName) at: #CompilerDoubleName) instVarNames size = 3.
]

testAttributes [
<category: 'testing'>

self deny: (Smalltalk includesGlobalNamed: #CompilerAttributes).

STEvaluationDriver new
parseSmalltalkStream: self attributes readStream
with: GSTFileInParser.

self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo1) attributes size = 1.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo1) attributes first selector = #xork.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo1) attributes first numArgs = 0.

self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo2) attributes size = 1.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo2) attributes first selector = #'bar:foo:'.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo2) attributes first numArgs = 2.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo2) attributes first arguments first = 123.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo2) attributes first arguments second = 234.

self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo3) attributes size = 1.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo3) attributes first selector = #'bar:foo:'.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo3) attributes first numArgs = 2.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo3) attributes first arguments first = 123.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo3) attributes first arguments second = 234.

self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo4) attributes size = 1.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo4) attributes first selector = #'bar:foo:'.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo4) attributes first numArgs = 2.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo4) attributes first arguments first = 123.
self assert: ((Smalltalk CompilerAttributes CAttributes) >> #foo4) attributes first arguments second = 234.
]
]

0 comments on commit 9b6190d

Please sign in to comment.