>From 6705f3f8b279849ff8a5c932aba30887d25928c4 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <address@hidden>
Date: Thu, 27 Jun 2013 15:18:30 +0200
Subject: [PATCH] Debug informations were added in the VM compiler, now they
 are added in the STCompiler with a test case in the file
 DebugInformationTests.st

---
 ChangeLog                                       |  8 +++
 kernel/CompildMeth.st                           |  1 +
 kernel/MethodInfo.st                            |  5 ++
 packages/stinst/parser/DebugInformationTests.st | 65 +++++++++++++++++++++++++
 packages/stinst/parser/STCompiler.st            | 17 ++++++-
 packages/stinst/parser/package.xml              |  2 +
 6 files changed, 97 insertions(+), 1 deletion(-)
 create mode 100644 packages/stinst/parser/DebugInformationTests.st

diff --git a/ChangeLog b/ChangeLog
index 6849558..e4d94e6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2013-06-27  Gwenael Casaccio <address@hidden>
+
+        * kernel/CompildMeth.st: Don't change the method class if it's the same.
+        * kernel/MethodInfo.st: Add a debug information setter.
+        * packages/stinst/parser/DebugInformationTests.st: Add a debug information test case.
+        * packages/stinst/parser/STCompiler.st: Add  DebugInformation support.
+        * packages/stinst/parser/package.xml: Add the new test case.
+
 2013-05-20  Holger Hans Peter Freyther  <address@hidden>
 
 	* configure.ac: Add --enable-postgres-tests.
diff --git a/kernel/CompildMeth.st b/kernel/CompildMeth.st
index 5a9b056..4d551d5 100644
--- a/kernel/CompildMeth.st
+++ b/kernel/CompildMeth.st
@@ -293,6 +293,7 @@ instances.'>
 	 to class"
 
 	<category: 'accessing'>
+        self methodClass == class ifTrue: [ ^ self ].
 	^self methodClass isNil 
 	    ifTrue: 
 		[self
diff --git a/kernel/MethodInfo.st b/kernel/MethodInfo.st
index 47ef495..c3569de 100644
--- a/kernel/MethodInfo.st
+++ b/kernel/MethodInfo.st
@@ -141,6 +141,11 @@ code of the method.'>
 	sourceCode := source
     ]
 
+    setDebugInformation: aDebugInfo [
+	<category: 'private'>
+        debugInfo := aDebugInfo
+    ]
+
     argumentsFor: anObject [
         <category: 'accessing'>
 
diff --git a/packages/stinst/parser/DebugInformationTests.st b/packages/stinst/parser/DebugInformationTests.st
new file mode 100644
index 0000000..d55c054
--- /dev/null
+++ b/packages/stinst/parser/DebugInformationTests.st
@@ -0,0 +1,65 @@
+"======================================================================
+|
+|   DebugInformation tests
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright (C) 2013 Free Software Foundation, Inc.
+| Written by Gwenael Casaccio.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+| 
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+| 
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+Namespace current: STInST.Tests [
+
+TestCase subclass: TestDebugInformation [
+
+    | behavior |
+
+    setUp [
+        <category: 'setup'>
+
+        behavior := Behavior new.
+        behavior superclass: Object.
+    ]
+
+    testDebugInformation [
+        <category: 'testing'>
+
+        | mth |
+        mth := behavior compile: 'a_1: i_1 a_2: i_2 [
+    | i j k |
+
+    ^ [ :a :b :c | | d e f | ]
+]'.
+
+        self assert: (mth arguments = #(#'i_1' #'i_2')).
+        self assert: (mth temporaries =  #(#'i' #'j' #'k')).
+        self assert: ((mth blockAt: 1) arguments = #(#'a' #'b' #'c')).
+        self assert: ((mth blockAt: 1) temporaries =  #(#'d' #'e' #'f')).
+    ]
+
+]
+
+]
+
diff --git a/packages/stinst/parser/STCompiler.st b/packages/stinst/parser/STCompiler.st
index 74fc9a8..42f1f83 100644
--- a/packages/stinst/parser/STCompiler.st
+++ b/packages/stinst/parser/STCompiler.st
@@ -53,7 +53,7 @@ Actually, I am used when conditionally compiled code has to be skipped.'>
 
 
 STFakeCompiler subclass: STCompiler [
-    | node destClass symTable parser bytecodes depth maxDepth isInsideBlock |
+    | node destClass symTable parser bytecodes depth maxDepth isInsideBlock debugInfo |
     
     <comment: 'Unlike my brother STFakeCompiler, I am a real worker. Give me some nodes, and
 I will output a full-fledged CompiledMethod!!
@@ -170,6 +170,7 @@ indexed'' bytecode. The resulting stream is
 	parser := aParser.
 	bytecodes := WriteStream on: (ByteArray new: 240).
 	isInsideBlock := 0.
+        debugInfo := IdentityDictionary new.
 	symTable declareEnvironment: aBehavior
     ]
 
@@ -478,6 +479,7 @@ indexed'' bytecode. The resulting stream is
 		    depth: maxDepth + node body temporaries size + node arguments size.
 	(method descriptor)
 	    setSourceCode: node source asSourceCode;
+            setDebugInformation: debugInfo;
 	    methodClass: symTable environment;
 	    selector: node selector.
 	method attributesDo: 
@@ -488,6 +490,7 @@ indexed'' bytecode. The resulting stream is
 		    ifTrue: 
 			[error := handler value: method value: ann.
 			error notNil ifTrue: [self compileError: error]]].
+        self createDebugInformationFor: method from: node.
 	^method
     ]
 
@@ -543,6 +546,7 @@ indexed'' bytecode. The resulting stream is
 		    bytecodes: bc
 		    depth: self maxDepth
 		    literals: self literals.
+        self createDebugInformationFor: block from: aNode.
 	self depthSet: depth.
 	clean := block flags.
 	clean == 0 
@@ -994,6 +998,17 @@ indexed'' bytecode. The resulting stream is
 	selector := selectorBuilder contents asSymbol.
 	^Message selector: selector arguments: arguments contents
     ]
+
+
+    createDebugInformationFor: aCompiledCode from: aNode [
+	<category: 'debug informations'>
+
+        debugInfo 
+            at: aCompiledCode
+            put: (DebugInformation 
+                    variables: ((aNode argumentNames collect: [ :each | each asSymbol]),  
+                                (aNode body temporaryNames collect: [ :each | each asSymbol])) asArray).
+    ]
 ]
 
 
diff --git a/packages/stinst/parser/package.xml b/packages/stinst/parser/package.xml
index f14f6e0..ba9ed69 100644
--- a/packages/stinst/parser/package.xml
+++ b/packages/stinst/parser/package.xml
@@ -33,8 +33,10 @@
    <sunit>STInST.Tests.TestScanner</sunit>
    <sunit>STInST.Tests.TestDefaultPoolResolution</sunit>
    <sunit>STInST.Tests.TestClassicPoolResolution</sunit>
+   <sunit>STInST.Tests.TestDebugInformation</sunit>
    <filein>RewriteTests.st</filein>
    <filein>PoolResolutionTests.st</filein>
+   <filein>DebugInformationTests.st</filein>
   </test>
 
   <file>ChangeLog</file>
-- 
1.8.1.2