[squeak-dev] The Trunk: Kernel-mt.1303.mcz

Thiede, Christoph Christoph.Thiede at student.hpi.uni-potsdam.de
Fri Feb 21 15:36:54 UTC 2020


Hi Marcel, thanks for merging! :-)

(You did not mention the fix of #doesNotUnderstand: simulation, but it does not matter.)


Just two interested questions:

1. Does Monticello provide an option for me to watch the changes you adapted to my commits directly? "Changes" against my working copy show so much noise (a have many changes in my working copy) that I cannot see the interesting changes there.

2. #isSpecialCategoryName: - what was the reason not to use #includes: but #or: here? Performance? Just curious :-)


Best,

Christoph

________________________________
Von: Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im Auftrag von commits at source.squeak.org <commits at source.squeak.org>
Gesendet: Freitag, 21. Februar 2020 16:20:35
An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org
Betreff: [squeak-dev] The Trunk: Kernel-mt.1303.mcz

Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-mt.1303.mcz

==================== Summary ====================

Name: Kernel-mt.1303
Author: mt
Time: 21 February 2020, 4:20:32.494211 pm
UUID: 0ef679e3-e47a-9945-b433-a81e5ecb8bf7
Ancestors: Kernel-ct.1287, Kernel-ct.1296, Kernel-ct.1298, Kernel-ct.1302, Kernel-eem.1296

Merges several smaller fixes from inbox. Thanks Christoph (ct)!

- fixes drag-drop methods between classes on the "--all--" category
- fixes two simulation bugs concerning #ensure: and #on:do:
- fixes ObjectTracer DNU
- fixes #readCarefullyFrom: in Object by correctly catching SyntaxErrorNotification

=============== Diff against Kernel-eem.1296 ===============

Item was changed:
  ----- Method: Categorizer>>addCategory:before: (in category 'accessing') -----
  addCategory: catString before: nextCategory
         "Add a new category named heading.
         If default category exists and is empty, remove it.
         If nextCategory is nil, then add the new one at the end,
         otherwise, insert it before nextCategory."
         | index newCategory |
         newCategory := catString asSymbol.
         (categoryArray indexOf: newCategory) > 0
                 ifTrue: [^self].        "heading already exists, so done"
+        (self isSpecialCategoryName: newCategory)
+                ifTrue: [^self inform: 'This category name is system reserved' translated].
         index := categoryArray indexOf: nextCategory
                 ifAbsent: [categoryArray size + 1].
         categoryArray := categoryArray
                 copyReplaceFrom: index
                 to: index-1
                 with: (Array with: newCategory).
         categoryStops := categoryStops
                 copyReplaceFrom: index
                 to: index-1
                 with: (Array with: (index = 1
                                 ifTrue: [0]
                                 ifFalse: [categoryStops at: index-1])).
         "remove empty default category"
         (newCategory ~= Default
                         and: [(self listAtCategoryNamed: Default) isEmpty])
                 ifTrue: [self removeCategory: Default]!

Item was changed:
  ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'classifying') -----
  classify: element under: heading suppressIfDefault: aBoolean
         "Store the argument, element, in the category named heading.   If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"

         | catName catIndex elemIndex realHeading |
+        realHeading := (heading isNil or: [self isSpecialCategoryName: heading])
+                ifTrue: [Default]
+                ifFalse: [heading asSymbol].
-        ((heading = NullCategory) or: [heading == nil])
-                ifTrue: [realHeading := Default]
-                ifFalse: [realHeading := heading asSymbol].
         (catName := self categoryOfElement: element) = realHeading
                 ifTrue: [^ self].  "done if already under that category"

+        catName ifNotNil: [
+                (aBoolean and: [realHeading = Default])
-        catName ~~ nil ifTrue:
-                [(aBoolean and: [realHeading = Default])
                                 ifTrue: [^ self].         "return if non-Default category already assigned in memory"
                 self basicRemoveElement: element].      "remove if in another category"

         (categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].

         catIndex := categoryArray indexOf: realHeading.
         elemIndex :=
                 catIndex > 1
                         ifTrue: [categoryStops at: catIndex - 1]
                         ifFalse: [0].
         [(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex)
                 and: [element >= (elementArray at: elemIndex)]] whileTrue.

         "elemIndex is now the index for inserting the element. Do the insertion before it."
         elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1
                                                 with: (Array with: element).

         "add one to stops for this and later categories"
         catIndex to: categoryArray size do:
                 [:i | categoryStops at: i put: (categoryStops at: i) + 1].

         ((categoryArray includes: Default)
                 and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default].

         self assertInvariant.!

Item was added:
+ ----- Method: Categorizer>>isSpecialCategoryName: (in category 'testing') -----
+ isSpecialCategoryName: aName
+
+        ^ aName = self class nullCategory
+                or: [aName = self class allCategory]!

Item was changed:
  ----- Method: Context class>>contextEnsure: (in category 'special context creation') -----
  contextEnsure: block
+        "Create an #ensure: context that is ready to return from executing its receiver.
+
+        As ctxt is *not* a top context as required by #jump, we need to put a (fake) return value (nil) on its stack. Otherwise, #jump will pop something different from the stack. Concretely, this caused the bug described in [1] (Scenario 1) because the latest stack top was the closure vector {chain}. This closure vector was accidently popped away so that in the final return statement, #pushRemoteTemp:inVectorAt: raised an error subscript bounds (because the next stack item was not variable). Read the linked bug report for more details.
-        "Create an #ensure: context that is ready to return from executing its receiver"

+        [1] http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFrom-td5107263.html"
+
         | ctxt chain |
         ctxt := thisContext.
+        [chain := thisContext sender cut: ctxt.
+        ctxt push: nil. "fake return value"
+        ctxt jump] ensure: block.
-        [chain := thisContext sender cut: ctxt. ctxt jump] ensure: block.
         "jump above will resume here without unwinding chain"
         ^ chain!

Item was changed:
  ----- Method: Context class>>contextOn:do: (in category 'special context creation') -----
  contextOn: exceptionClass do: block
+        "Create an #on:do: context that is ready to return from executing its receiver.
+
+        As ctxt is *not* a top context as required by #jump, we need to put a (fake) return value (nil) on its stack. Otherwise, #jump will pop something different from the stack. Concretely, this caused the bug described in [1] (Scenario 1) because the latest stack top was the closure vector {chain}. This closure vector was accidently popped away so that in the final return statement, #pushRemoteTemp:inVectorAt: raised an error subscript bounds (because the next stack item was not variable). Read the linked bug report for more details.
-        "Create an #on:do: context that is ready to return from executing its receiver"

+        [1] http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFrom-td5107263.html"
+
         | ctxt chain |
         ctxt := thisContext.
+        [chain := thisContext sender cut: ctxt.
+        ctxt push: nil. "fake return value"
+        ctxt jump] on: exceptionClass do: block.
-        [chain := thisContext sender cut: ctxt. ctxt jump] on: exceptionClass do: block.
         "jump above will resume here without unwinding chain"
         ^ chain!

Item was changed:
  ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') -----
  send: selector to: rcvr with: arguments lookupIn: lookupClass
         "Simulate the action of sending a message with selector and arguments
          to rcvr. The argument, lookupClass, is the class in which to lookup the
          message.  This is the receiver's class for normal messages, but for super
          messages it will be some specific class related to the source method."

         | meth primIndex val ctxt |
         (meth := lookupClass lookupSelector: selector) ifNil:
                 [^self send: #doesNotUnderstand:
                                 to: rcvr
+                                with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass}
-                                with: {Message selector: selector arguments: arguments}
                                 lookupIn: lookupClass].
         meth numArgs ~= arguments size ifTrue:
                 [^self error: 'Wrong number of arguments in simulated message ', selector printString].
         (primIndex := meth primitive) > 0 ifTrue:
                 [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
                  (self isPrimFailToken: val) ifFalse:
                         [^val]].
         (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
                 [^self error: 'Simulated message ', arguments first selector, ' not understood'].
         ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments.
         primIndex > 0 ifTrue:
                 [ctxt failPrimitiveWith: val].
         ^ctxt!

Item was added:
+ ----- Method: Object class>>basicReadFrom: (in category 'instance creation') -----
+ basicReadFrom: textStringOrStream
+        "Create an object based on the contents of textStringOrStream."
+
+        | object |
+        (Compiler couldEvaluate: textStringOrStream)
+                ifFalse: [^ self error: 'expected String, Stream, or Text' translated].
+        object := self environment beCurrentDuring: [
+                Compiler evaluate: textStringOrStream environment: self environment].
+        (object isKindOf: self) ifFalse: [self error: ('{1} expected' translated format: {self name})].
+        ^object!

Item was changed:
  ----- Method: Object class>>readCarefullyFrom: (in category 'instance creation') -----
  readCarefullyFrom: textStringOrStream
         "Create an object based on the contents of textStringOrStream.  Return an error instead of putting up a SyntaxError window."

+        ^ [self basicReadFrom: textStringOrStream]
+                on: SyntaxErrorNotification
+                do: [:ex | self error: ex messageText]!
-        | object |
-        (Compiler couldEvaluate: textStringOrStream)
-                ifFalse: [^ self error: 'expected String, Stream, or Text'].
-        object := Compiler evaluate: textStringOrStream for: nil
-                                notifying: #error: "signal we want errors".
-        (object isKindOf: self) ifFalse: [self error: self name, ' expected'].
-        ^object!

Item was changed:
  ----- Method: Object class>>readFrom: (in category 'instance creation') -----
  readFrom: textStringOrStream
         "Create an object based on the contents of textStringOrStream."

+        ^ self basicReadFrom: textStringOrStream!
-        | object |
-        (Compiler couldEvaluate: textStringOrStream)
-                ifFalse: [^ self error: 'expected String, Stream, or Text'].
-        object := self environment beCurrentDuring: [Compiler evaluate: textStringOrStream environment: self environment].
-        (object isKindOf: self) ifFalse: [self error: self name, ' expected'].
-        ^object!

Item was removed:
- ----- Method: ObjectTracer class>>initialize (in category 'initialize-release') -----
- initialize
-        "Fix for inconsistent image state in which ObjectTracer improperly appears as a subclass
-        of Class. This initialization should appear in the Squeak update stream in order to repair
-        existing images, and may be removed in a future update."
-
-        Class removeSubclass: ObjectTracer class!

Item was changed:
  ----- Method: ObjectTracer>>doesNotUnderstand: (in category 'very few messages') -----
  doesNotUnderstand: aMessage
+        "Present a debugger before proceeding to re-send the message"
-        "All external messages (those not caused by the re-send) get trapped here"
-        "Present a dubugger before proceeding to re-send the message"

+        "All external messages (those not caused by the re-send) get trapped here"
+        Warning signal: ('About to perform: {1}' translated format: {aMessage selector storeString}).
+        ^ aMessage sendTo: tracedObject!
-        self notify: 'About to perform: ', aMessage selector.
-        ^ aMessage sentTo: tracedObject.
- !


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20200221/e4db9ba8/attachment.html>


More information about the Squeak-dev mailing list