On 27/06/2013 10:21, Paolo Bonzini wrote:
Il 23/06/2013 19:45, Holger Hans Peter Freyther ha scritto:
On Tue, Jun 11, 2013 at 11:30:33PM +0200, Gwenaël Casaccio wrote:
Good Evening,
here some quick comments on the code and commit message.
When a compiled method is copied some literals (block and closures)
need to be fixed: they are pointing to the bad method. Also the debug
information need to be patched to point to the new literals array.
"useless"/"bad". These words carry judgement but there is no poin in
judging. I would very much prefer if you could use a more neutral tone
in your commit messages.
Could you elaborate on how you stumbled across this? When did you copy
the CompiledMethod? What was the usecase?
+GST_PACKAGE_ENABLE([Tests], [tests])
"Tests" is very generic. What about "SystemTests"? I understand that
using SUnit is nicer than the GNU autotest framework and personally I
can understand that.
Or KernelTests. It's a pity that Kernel is not a regular package. :(
+ method: aCompiledCode [
+ <category: 'accessing'>
+
+ block method: aCompiledCode
+ ]
Sounds more like a private method to me, than 'accessing'.
Agreed.
+ deepCopy [
^super deepCopy
+ fixBlockInformation;
+ fixDebugInformation: self;
+ makeLiteralsReadOnly;
yourself
why didn't this work? Otherwise you will need to adjust your test
case to also test for classes where isPointers evaluates to true.
+ (literals at: i) class == BlockClosure ifTrue: [
+ | new_block |
+ new_block := (literals at: i) deepCopy.
No underscores in variable names.
+ new_block block: new_block block copy.
+ new_block method: self.
+ literals at: i put: new_block ]. ]
can you please elaborate on these lines? First youtake a deep copy
and then you take a copy of the deep copied block? Why is that needed?
+ postCopy [
+ "Private - Make a deep copy of the descriptor and literals.
+ Don't need to replace the method header and bytecodes, since they
+ are integers."
+
+ <category: 'private-copying'>
+
+ super postCopy.
+ descriptor := descriptor copy.
+ literals := literals copy.
+ self fixBlockInformation.
+ self makeLiteralsReadOnly.
+ "literals := literals deepCopy.
+ self makeLiteralsReadOnly"
time to remove the commented out code as you are doing this now? Did you
do the archology to see if these two lines have ever been enabled in the
last couple of years?
+ method: aCompiledMethod [
+ <category: 'accessing'>
it is not really accessing when you modify a class. :)
+TestCase subclass: TestCompiledMethod [
+
+ setUp [
+ <category: 'setup'>
+
+ Object subclass: #Bar.
+ Object subclass: #Foo.
a tearDown should remove this class too.
I think it's better to create the classes unconditionally.
setUp/tearDown can create and remove the methods, though.
Paolo
+ testCopy [
...
+ self assert: old_method ~~ new_method.
+ self assert: old_method literals ~~ new_method literals.
+ self assert: old_method getHeader == new_method getHeader.
+ self assert: old_method descriptor ~~ new_method descriptor.
+ self assert: old_method descriptor debugInformation ~~ new_method
descriptor debugInformation.
matching bytecodes could be added?
+ testDeepCopy [
+ <category: 'testing'>
can some code from the above be re-used and also with the below.
+ ]
+
+ testWithNewMethodClass [
+ <category: 'testing'>
thanks for the patch!
_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
https://lists.gnu.org/mailman/listinfo/help-smalltalk
All the points should be fixed in the patch
Gwen
>From 4bdadcea7b09d4d6c5edcf5f3e3d199ffe4d72d8 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <mrg...@gmail.com>
Date: Thu, 27 Jun 2013 17:36:14 +0200
Subject: [PATCH] Add a new Kernel-Tests package and a better support for
method copying.
When a compiled method is copied some literals (block and closures)
need to be updated: they have references to the old method. The debug
information also need to be updated to point to the new literals array.
---
ChangeLog | 9 ++
configure.ac | 1 +
kernel/BlkClosure.st | 6 ++
kernel/CompildMeth.st | 79 +++++++++++---
kernel/CompiledBlk.st | 6 ++
kernel/MethodInfo.st | 34 +++++++
packages/kernel-tests/ChangeLog | 4 +
.../kernel-tests/kernel/CompiledMethodTests.st | 113 +++++++++++++++++++++
packages/kernel-tests/package.xml | 10 ++
tests/testsuite.at | 1 +
10 files changed, 251 insertions(+), 12 deletions(-)
create mode 100644 packages/kernel-tests/ChangeLog
create mode 100644 packages/kernel-tests/kernel/CompiledMethodTests.st
create mode 100644 packages/kernel-tests/package.xml
diff --git a/ChangeLog b/ChangeLog
index e4d94e6..7239658 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2013-06-27 Gwenael Casaccio <gwenael.casac...@gmail.com>
+ * kernel/BlkClosure.st: Add accessor.
+ * kernel/CompildMeth.st: DeepCopy fixes references in method information, block closure and compiled block.
+ * kernel/CompiledBlk.st: Add accessor.
+ * kernel/MethodInfo.st: Add method that change debug references to the new compiled method, block or block closure.
+ * configure.ac: Introduce the Kernel-Tests package.
+ * tests/testsuite.at: Add the Kernel-Tests package.
+
+2013-06-27 Gwenael Casaccio <gwenael.casac...@gmail.com>
+
* 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.
diff --git a/configure.ac b/configure.ac
index 56c09cb..e53b6c2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -517,6 +517,7 @@ GST_PACKAGE_ENABLE([Digest], [digest], [], [], [Makefile], [digest.la])
GST_PACKAGE_ENABLE([GNUPlot], [gnuplot])
GST_PACKAGE_ENABLE([Magritte], [magritte])
GST_PACKAGE_ENABLE([Magritte-Seaside], [seaside/magritte])
+GST_PACKAGE_ENABLE([Kernel-Tests], [kernel-tests])
GST_PACKAGE_ENABLE([NCurses],
[ncurses],
diff --git a/kernel/BlkClosure.st b/kernel/BlkClosure.st
index ec17d2b..af85fbc 100644
--- a/kernel/BlkClosure.st
+++ b/kernel/BlkClosure.st
@@ -622,6 +622,12 @@ creation of Processes from blocks.'>
SystemExceptions.WrongArgumentCount signal
]
+ method: aCompiledCode [
+ <category: 'private'>
+
+ block method: aCompiledCode
+ ]
+
valueAndResumeOnUnwind [
"Private - For use by #ensure:"
diff --git a/kernel/CompildMeth.st b/kernel/CompildMeth.st
index 4d551d5..e0be59d 100644
--- a/kernel/CompildMeth.st
+++ b/kernel/CompildMeth.st
@@ -143,6 +143,36 @@ instances.'>
self allInstancesDo: [:each | each stripSourceCode]
]
+ copy [
+ <category: 'copying'>
+
+ | copy |
+ copy := super copy.
+ copy fixDebugInformation: self.
+ ^ copy
+ ]
+
+ deepCopy [
+ "Returns a deep copy of the receiver (the instance variables are
+ copies of the receiver's instance variables)"
+
+ <category: 'copying'>
+ | class aCopy num |
+ class := self class.
+ aCopy := self shallowCopy.
+ class isPointers
+ ifTrue: [num := class instSize + self basicSize]
+ ifFalse: [num := class instSize].
+
+ "copy the instance variables (if any)"
+ 1 to: num do: [:i | aCopy instVarAt: i put: (self instVarAt: i) copy].
+ aCopy
+ fixBlockInformation;
+ fixDebugInformation: self;
+ makeLiteralsReadOnly.
+ ^aCopy
+ ]
+
sourceCodeLinesDelta [
"Answer the delta from the numbers in LINE_NUMBER bytecodes
to source code line numbers."
@@ -591,18 +621,6 @@ instances.'>
nextPutAll: self selector
]
- postCopy [
- "Private - Make a deep copy of the descriptor and literals.
- Don't need to replace the method header and bytecodes, since they
- are integers."
-
- <category: 'private'>
- super postCopy.
- descriptor := descriptor copy
- "literals := literals deepCopy.
- self makeLiteralsReadOnly"
- ]
-
makeLiteralsReadOnly [
<category: 'private'>
literals isNil ifTrue: [^self].
@@ -781,5 +799,42 @@ instances.'>
^ self descriptor temporariesFor: anObject
]
+
+ fixBlockInformation [
+ <category: 'private-copying'>
+
+ 1 to: literals size do: [ :i |
+ (literals at: i) class == CompiledBlock ifTrue: [
+ | newBlock |
+ newBlock := (literals at: i) copy.
+ newBlock method: self.
+ literals at: i put: newBlock ].
+ (literals at: i) class == BlockClosure ifTrue: [
+ | newBlock |
+ newBlock := (literals at: i) deepCopy.
+ newBlock block: newBlock block copy.
+ newBlock method: self.
+ literals at: i put: newBlock ]. ]
+ ]
+
+ fixDebugInformation: aCompiledMethod [
+ <category: 'private-copying'>
+
+ descriptor fixDebugInformation: aCompiledMethod replaceWith: self
+ ]
+
+ postCopy [
+ "Private - Make a deep copy of the descriptor and literals.
+ Don't need to replace the method header and bytecodes, since they
+ are integers."
+
+ <category: 'private-copying'>
+
+ super postCopy.
+ descriptor := descriptor copy.
+ literals := literals copy.
+ self fixBlockInformation.
+ self makeLiteralsReadOnly.
+ ]
]
diff --git a/kernel/CompiledBlk.st b/kernel/CompiledBlk.st
index d5ca707..08c98cf 100644
--- a/kernel/CompiledBlk.st
+++ b/kernel/CompiledBlk.st
@@ -138,6 +138,12 @@ CompiledCode subclass: CompiledBlock [
^super = aMethod and: [method = aMethod method]
]
+ method: aCompiledMethod [
+ <category: 'accessing'>
+
+ method := aCompiledMethod
+ ]
+
method [
"Answer the CompiledMethod in which the receiver lies"
diff --git a/kernel/MethodInfo.st b/kernel/MethodInfo.st
index c3569de..a6dbe63 100644
--- a/kernel/MethodInfo.st
+++ b/kernel/MethodInfo.st
@@ -141,6 +141,11 @@ code of the method.'>
sourceCode := source
]
+ debugInformation [
+ <category: 'private'>
+ ^ debugInfo
+ ]
+
setDebugInformation: aDebugInfo [
<category: 'private'>
debugInfo := aDebugInfo
@@ -157,5 +162,34 @@ code of the method.'>
^ (debugInfo at: anObject) temporaries: anObject numArgs
]
+
+ postCopy [
+ <category: 'private-copying'>
+
+ super postCopy.
+ debugInfo := debugInfo copy
+ ]
+
+ fixDebugInformation: anOldCompiledMethod replaceWith: aNewCompiledMethod [
+ <category: 'private-copying'>
+
+ self debugInfoReplace: anOldCompiledMethod with: aNewCompiledMethod.
+ 1 to: anOldCompiledMethod literals size do: [ :i |
+ (anOldCompiledMethod literals at: i) class == CompiledBlock ifTrue: [
+ self debugInfoReplace: (anOldCompiledMethod literals at: i) with: (aNewCompiledMethod literals at: i) ].
+ (anOldCompiledMethod literals at: i) class == BlockClosure ifTrue: [
+ self debugInfoReplace: (anOldCompiledMethod literals at: i) block with: (aNewCompiledMethod literals at: i) block ] ]
+ ]
+
+ debugInfoReplace: aKey with: aNewKey [
+ <category: 'private-copying'>
+
+ | assoc |
+ assoc := debugInfo associationAt: aKey.
+ debugInfo remove: assoc.
+ assoc key: aNewKey.
+ debugInfo add: assoc.
+ ]
+
]
diff --git a/packages/kernel-tests/ChangeLog b/packages/kernel-tests/ChangeLog
new file mode 100644
index 0000000..6820768
--- /dev/null
+++ b/packages/kernel-tests/ChangeLog
@@ -0,0 +1,4 @@
+2013-06-11 Gwenael Casaccio <gwenael.casac...@gmail.com>
+
+ * kernel/CompiledMethodTests.st: Test compiled methods
+
diff --git a/packages/kernel-tests/kernel/CompiledMethodTests.st b/packages/kernel-tests/kernel/CompiledMethodTests.st
new file mode 100644
index 0000000..d2a8af8
--- /dev/null
+++ b/packages/kernel-tests/kernel/CompiledMethodTests.st
@@ -0,0 +1,113 @@
+TestCase subclass: TestCompiledMethod [
+
+ | barClass fooClass |
+
+ setUp [
+ <category: 'setup'>
+
+ barClass := Behavior new.
+ fooClass := Behavior new.
+ fooClass compile: '
+ fakeDeepCopy [
+ <category: ''copying''>
+ | class aCopy num |
+ class := self class.
+ aCopy := self shallowCopy.
+ class isPointers
+ ifTrue: [num := class instSize + self basicSize]
+ ifFalse: [num := class instSize].
+
+ "copy the instance variables (if any)"
+ 1 to: num do: [:i | aCopy instVarAt: i put: (self instVarAt: i) copy].
+ [ :aCopy | aCopy
+ fixBlockInformation;
+ fixDebugInformation: self.
+ ^aCopy ] value: aCopy.
+ [ :bla | bla value ] value: 123
+ ]'.
+ fooClass compile:
+'optimized_1 [ ^ #(1 2 3) ]'.
+ fooClass compile:
+'primitive_1 [ <primitive: ', VMpr_Object_shallowCopy asString, '> ]'.
+
+ ]
+
+ check: old_method with: new_method [
+ <category: 'private'>
+
+ self assert: old_method ~~ new_method.
+ self assert: old_method literals ~~ new_method literals.
+ self assert: old_method getHeader == new_method getHeader.
+ self assert: old_method descriptor ~~ new_method descriptor.
+ self assert: old_method descriptor debugInformation ~~ new_method descriptor debugInformation.
+
+ self assert: old_method basicSize == new_method basicSize.
+ 1 to: old_method basicSize do: [ :i |
+ self assert: (old_method at: i) == (new_method at: i) ].
+
+ self assert: old_method descriptor debugInformation size = new_method descriptor debugInformation size.
+ old_method descriptor debugInformation keysAndValuesDo: [ :key :value |
+ self should: [ new_method descriptor debugInformation at: key ] raise: SystemExceptions.NotFound ]. " should fail because the method and all the blocks are copied "
+
+ self assert: (new_method temporaries) = #(#class #aCopy #num).
+ new_method allBlocksDo: [ :each | self assert: (each method == new_method) ].
+ ]
+
+ testCopy [
+ <category: 'testing'>
+
+ | old_method new_method |
+ old_method := fooClass>>#fakeDeepCopy.
+ new_method := old_method deepCopy.
+
+ self check: old_method with: new_method.
+ ]
+
+ testDeepCopy [
+ <category: 'testing'>
+
+ | old_method new_method |
+ old_method := fooClass>>#fakeDeepCopy.
+ new_method := old_method deepCopy.
+
+ self check: old_method with: new_method.
+ ]
+
+ testWithNewMethodClass [
+ <category: 'testing'>
+
+ | old_method new_method |
+ old_method := fooClass>>#fakeDeepCopy.
+ new_method := old_method withNewMethodClass: fooClass.
+
+ self assert: new_method == old_method.
+
+ old_method := fooClass>>#fakeDeepCopy.
+ new_method := old_method withNewMethodClass: barClass.
+
+ self check: old_method with: new_method.
+ ]
+
+ testPrimitive [
+ <category: 'testing'>
+
+ | method |
+ method := fooClass>>#optimized_1.
+ self assert: method primitive = 0.
+
+ method := fooClass>>#primitive_1.
+ self assert: method primitive = VMpr_Object_shallowCopy.
+ ]
+
+ testSyntax [
+ <category: 'testing'>
+
+ | method |
+ method := fooClass>>#optimized_1.
+ self assert: method isOldSyntax not.
+
+ method := fooClass>>#primitive_1.
+ self assert: method isOldSyntax not.
+ ]
+]
+
diff --git a/packages/kernel-tests/package.xml b/packages/kernel-tests/package.xml
new file mode 100644
index 0000000..4dc8484
--- /dev/null
+++ b/packages/kernel-tests/package.xml
@@ -0,0 +1,10 @@
+<package>
+ <name>Kernel-Tests</name>
+
+ <test>
+ <sunit>TestCompiledMethod</sunit>
+ <filein>kernel/CompiledMethodTests.st</filein>
+ </test>
+
+ <file>ChangeLog</file>
+</package>
diff --git a/tests/testsuite.at b/tests/testsuite.at
index 8cd2b1c..b95e1bf 100644
--- a/tests/testsuite.at
+++ b/tests/testsuite.at
@@ -156,6 +156,7 @@ AT_PACKAGE_TEST([DhbNumericalMethods])
AT_PACKAGE_TEST([Digest])
AT_OPTIONAL_PACKAGE_TEST([GDBM])
AT_OPTIONAL_PACKAGE_TEST([Iconv])
+AT_PACKAGE_TEST([Kernel-Tests])
AT_PACKAGE_TEST([Magritte])
AT_OPTIONAL_PACKAGE_TEST([ROE])
AT_PACKAGE_TEST([ObjectDumper])
--
1.8.1.2
_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
https://lists.gnu.org/mailman/listinfo/help-smalltalk
