>From 4bdadcea7b09d4d6c5edcf5f3e3d199ffe4d72d8 Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio 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 + * 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 + * 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 [ + + + 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 [ + + + | 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)" + + + | 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." - - - super postCopy. - descriptor := descriptor copy - "literals := literals deepCopy. - self makeLiteralsReadOnly" - ] - makeLiteralsReadOnly [ literals isNil ifTrue: [^self]. @@ -781,5 +799,42 @@ instances.'> ^ self descriptor temporariesFor: anObject ] + + fixBlockInformation [ + + + 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 [ + + + 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." + + + + 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 [ + + + 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 [ + + ^ debugInfo + ] + setDebugInformation: aDebugInfo [ debugInfo := aDebugInfo @@ -157,5 +162,34 @@ code of the method.'> ^ (debugInfo at: anObject) temporaries: anObject numArgs ] + + postCopy [ + + + super postCopy. + debugInfo := debugInfo copy + ] + + fixDebugInformation: anOldCompiledMethod replaceWith: aNewCompiledMethod [ + + + 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 [ + + + | 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 + + * 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 [ + + + barClass := Behavior new. + fooClass := Behavior new. + fooClass compile: ' + fakeDeepCopy [ + + | 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 [ ]'. + + ] + + check: old_method with: new_method [ + + + 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 [ + + + | old_method new_method | + old_method := fooClass>>#fakeDeepCopy. + new_method := old_method deepCopy. + + self check: old_method with: new_method. + ] + + testDeepCopy [ + + + | old_method new_method | + old_method := fooClass>>#fakeDeepCopy. + new_method := old_method deepCopy. + + self check: old_method with: new_method. + ] + + testWithNewMethodClass [ + + + | 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 [ + + + | method | + method := fooClass>>#optimized_1. + self assert: method primitive = 0. + + method := fooClass>>#primitive_1. + self assert: method primitive = VMpr_Object_shallowCopy. + ] + + testSyntax [ + + + | 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 @@ + + Kernel-Tests + + + TestCompiledMethod + kernel/CompiledMethodTests.st + + + ChangeLog + 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