Class.st
changeset 1765 64e428dbb53d
parent 1759 5b7c001edc06
child 1766 5c07f58a54c9
--- a/Class.st	Wed Oct 16 17:00:50 1996 +0200
+++ b/Class.st	Wed Oct 16 18:06:17 1996 +0200
@@ -378,7 +378,7 @@
 revisionStringFromSource:aMethodSourceString
     "extract a revision string from a methods source string"
 
-    |lines|
+    |lines line|
 
     lines := aMethodSourceString asCollectionOfLines.
     lines do:[:l |
@@ -386,12 +386,18 @@
 
         i := l indexOfSubCollection:'$Header: '.
         i ~~ 0 ifTrue:[
-            ^ l copyFrom:i
+            line := l copyFrom:i.
+            i := line lastIndexOf:$$.
+            i > 1 ifTrue:[
+                line := line copyTo:i.
+            ].
+            ^ line
         ]
     ].
     ^ nil
 
     "Created: 15.10.1996 / 18:57:57 / cg"
+    "Modified: 16.10.1996 / 16:54:40 / cg"
 ! !
 
 !Class class methodsFor:'queries'!
@@ -3940,6 +3946,13 @@
 
         mgr notNil ifTrue:[
             aStream := mgr getSourceStreamFor:self.
+
+            (self validateSourceStream:aStream) ifFalse:[
+                ('CLASS: mgr source for ' , name , ' corrupted - try local file') infoPrintCR.
+                aStream close.
+                aStream := nil
+            ].
+
             aStream isNil ifTrue:[
                 fileName := Smalltalk getSourceFileName:source.
                 fileName notNil ifTrue:[
@@ -3965,7 +3978,7 @@
     "
 
     "Created: 10.11.1995 / 21:05:13 / cg"
-    "Modified: 15.10.1996 / 18:59:53 / cg"
+    "Modified: 16.10.1996 / 16:56:06 / cg"
 !
 
 updateVersionMethodFor:newRevisionString
@@ -4001,11 +4014,91 @@
 
     "Created: 7.12.1995 / 20:42:22 / cg"
     "Modified: 15.10.1996 / 18:59:58 / cg"
+!
+
+validateSourceStream:aStream
+    "check if aStream really contains my source.
+     This is done by checking the version methods return value
+     against the version string as contained in the version method"
+
+    |cls meta cannotCheck versionMethod info
+     versionFromCode versionFromSource oldPos pos src rev|
+
+    self isMeta ifTrue:[
+        meta := self. cls := self soleInstance
+    ] ifFalse:[
+        cls := self. meta := self class
+    ].
+
+    cannotCheck := false.
+
+    versionMethod := meta compiledMethodAt:#version.
+    (versionMethod isNil 
+    or:[versionMethod isExecutable not]) ifTrue:[
+        versionMethod := cls compiledMethodAt:#version.
+        (versionMethod isNil
+        or:[versionMethod isExecutable not]) ifTrue:[
+"/ 'no version method' printCR.
+            cannotCheck := true.
+        ]
+    ].
+
+    "/
+    "/ if its a method returning the string,
+    "/ thats the returned value
+    "/
+    versionFromCode := cls version.
+    versionFromCode isString ifFalse:[
+"/ 'version method does not return a string' printCR.
+        cannotCheck := true
+    ].
+
+    "/
+    "/ if its a method consisting of a comment only
+    "/ extract it - this may lead to a recursive call
+    "/ to myself (thats what the #isRecursive is for)
+    "/ in case we need to access the source code manager
+    "/ for the source ...
+    "/
+    pos := versionMethod sourcePosition.
+    pos isInteger ifFalse:[
+"/ 'no source position for version-method' printCR.
+        cannotCheck := true
+    ].
+
+    cannotCheck ifTrue:[
+        'CLASS: cannot validate source; trusting source' infoPrintCR.
+        ^ true
+    ].
+
+    oldPos := aStream position.
+    aStream position:pos.
+    src := aStream nextChunk.
+    aStream position:oldPos.
+
+    (src isNil or:[src isEmpty]) ifTrue:[
+"/ 'empty source for version-method' printCR.
+        ^ false
+    ].
+
+    versionFromSource := Class revisionStringFromSource:src.
+    versionFromSource = versionFromCode ifTrue:[^ true].
+
+    "/ mhmh - check my binary version ...
+
+    info := Class revisionInfoFromString:versionFromSource.
+    info notNil ifTrue:[
+        rev := info at:#revision.
+        rev = self binaryRevision ifTrue:[^ true].
+    ].
+    ^ false
+
+    "Modified: 16.10.1996 / 17:04:22 / cg"
 ! !
 
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.189 1996-10-15 20:21:04 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.190 1996-10-16 16:06:17 cg Exp $'
 ! !
 Class initialize!