SmalltalkChunkFileSourceWriter.st
branchjv
changeset 18042 2aa6ef1820fe
parent 18012 115575f67788
parent 14985 2e24694bc6f4
child 18045 c0c600e0d3b3
--- a/SmalltalkChunkFileSourceWriter.st	Wed Mar 27 17:12:46 2013 +0000
+++ b/SmalltalkChunkFileSourceWriter.st	Thu Mar 28 12:21:50 2013 +0000
@@ -12,7 +12,7 @@
 "{ Package: 'stx:libbasic' }"
 
 AbstractSourceFileWriter subclass:#SmalltalkChunkFileSourceWriter
-	instanceVariableNames:'classBeingSaved methodsAlreadySaved'
+	instanceVariableNames:'classBeingSaved methodsAlreadySaved generatingSourceForOriginal'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Classes'
@@ -110,6 +110,19 @@
     "Created: / 21-08-2012 / 11:52:27 / cg"
 ! !
 
+!SmalltalkChunkFileSourceWriter methodsFor:'accessing'!
+
+generatingSourceForOriginal:aBoolean
+    "if false (the default), the source of the current (in image) code is generated.
+     That means, that any extension method which shadows some other original method,
+     that extension method's code is generated.
+     if true, the code of the original method is generated.
+     Use a true value, when generating code for a SCM checkin operation, as then we do not
+     want the extension to shadow the original"
+
+    generatingSourceForOriginal := aBoolean.
+! !
+
 !SmalltalkChunkFileSourceWriter methodsFor:'source writing'!
 
 fileOut:aClass on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
@@ -356,7 +369,7 @@
      If both are nil, all are saved. See version-method handling in
      fileOut for what this is needed."
 
-    |sortedSelectors first prevPrivacy privacy interestingMethods cat|
+    |sortedSelectors first prevPrivacy privacy interestingMethods cat prjDef|
 
     interestingMethods := OrderedCollection new.
     aClass methodsDo:[:aMethod |
@@ -381,16 +394,36 @@
             ]
         ]
     ].
+
     interestingMethods notEmpty ifTrue:[
-        first := true.
-        prevPrivacy := nil.
-
         "/
         "/ sort by selector
         "/
         sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
         sortedSelectors sortWith:interestingMethods.
 
+        generatingSourceForOriginal == true ifTrue:[
+            "/ care for methods which have been shadowed by an extension from another package!!
+            (prjDef := aClass theNonMetaclass projectDefinitionClass) notNil ifTrue:[
+                prjDef hasSavedOverwrittenMethods ifTrue:[
+                    interestingMethods := interestingMethods collect:[:m |
+                                                |originalOrNil|
+                                                
+                                                (m package ~~ aClass package) ifTrue:[ 
+                                                    originalOrNil := prjDef savedOverwrittenMethods at:(aClass name -> m selector) ifAbsent:nil.
+                                                    originalOrNil notNil ifTrue:[ 
+                                                        self breakPoint:#cg 
+                                                    ].
+                                                ].
+                                                originalOrNil ? m
+                                          ].
+                ]
+            ].
+        ].
+
+        first := true.
+        prevPrivacy := nil.
+
         interestingMethods do:[:eachMethod |
             privacy := eachMethod privacy.
 
@@ -580,8 +613,12 @@
 
 !SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
 
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.21 2013-03-27 16:50:00 cg Exp $'
+!
+
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.19 2012-12-17 12:48:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.21 2013-03-27 16:50:00 cg Exp $'
 !
 
 version_SVN