>From f5df7d1d5fcda29e7575314884c9ed14f36816df Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <address@hidden>
Date: Wed, 2 Apr 2014 16:44:53 +0200
Subject: [PATCH] stinst: Fix support for keyword attributes 2014-04-02 
 Gwenael Casaccio  <address@hidden>

	* STCompiler.st: Support keyword attributes.
	* STCompilerTests.st: Test for method attributes.
---
 packages/stinst/parser/ChangeLog          |  5 +++++
 packages/stinst/parser/STCompiler.st      |  6 +++++-
 packages/stinst/parser/STCompilerTests.st | 36 +++++++++++++++++++++++++++++++
 3 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/packages/stinst/parser/ChangeLog b/packages/stinst/parser/ChangeLog
index accca65..10d56bd 100644
--- a/packages/stinst/parser/ChangeLog
+++ b/packages/stinst/parser/ChangeLog
@@ -1,3 +1,8 @@
+2014-04-02  Gwenael Casaccio  <address@hidden>
+
+	* STCompiler.st: Support keyword attributes.
+	* STCompilerTests.st: Test for method attributes.
+
 2014-02-07  Holger Hans Peter Freyther  <address@hidden>
 
 	* GSTParserTests.st: Remove installed classes at the end.
diff --git a/packages/stinst/parser/STCompiler.st b/packages/stinst/parser/STCompiler.st
index 098437d..341c0b1 100644
--- a/packages/stinst/parser/STCompiler.st
+++ b/packages/stinst/parser/STCompiler.st
@@ -984,6 +984,10 @@ indexed'' bytecode. The resulting stream is
 	selectorBuilder := WriteStream on: String new.
 	arguments := WriteStream on: Array new.
 	currentToken := self scanTokenFrom: scanner.
+        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'].
@@ -994,7 +998,7 @@ indexed'' bytecode. The resulting stream is
 		node := argParser parseBinaryMessageNoGreater.
 		node := RBSequenceNode statements: {node}.
 		arguments nextPut: (self class evaluate: node parser: argParser).
-		currentToken := argParser currentToken].
+		currentToken := argParser currentToken]].
 	selector := selectorBuilder contents asSymbol.
 	^Message selector: selector arguments: arguments contents
     ]
diff --git a/packages/stinst/parser/STCompilerTests.st b/packages/stinst/parser/STCompilerTests.st
index f4ae651..28d9304 100644
--- a/packages/stinst/parser/STCompilerTests.st
+++ b/packages/stinst/parser/STCompilerTests.st
@@ -41,6 +41,22 @@ Object subclass: CompilerDoubleName [
         
     ]
 
+    attributes [
+        ^ '
+Namespace current: (Smalltalk addSubspace: #CompilerAttributes).
+Object subclass: CAttributes [
+    foo1 [
+        <xork>
+    ]
+
+    foo2 [
+        <bar: 123 foo: 234>
+    ]
+
+]'
+        
+    ]
+
     testPoolResolution [
         <category: 'testing'>
 
@@ -54,4 +70,24 @@ 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.
+    ]
 ]
-- 
1.8.3.2