[squeak-dev] The Trunk: Kernel-nice.298.mcz

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Sat Nov 14 20:56:59 UTC 2009


Oops !
Wrong manipulation !
I pushed the new corrections for DependentsArray ( bug
http://bugs.squeak.org/view.php?id=2701 )

Previous implementation of DependentsArray did override super size,
but not super at:
The consequence is that it breaks the contract (super assumptions).
All super methods using (1 to: self size do: [:index | (self at:
index) doSomething ]) were bogus for a DependentsArray
Either we override all messages using this construction (crapy)
...or we change the hierarchy of DependentArray (what I did here).
Warning: we might loose a few protocol from SequenceableCollection
(many of them bogus).

What do you think, shall we keep this modification, or shall I retract ?

2009/11/14  <commits at source.squeak.org>:
> Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
> http://source.squeak.org/trunk/Kernel-nice.298.mcz
>
> ==================== Summary ====================
>
> Name: Kernel-nice.298
> Author: nice
> Time: 14 November 2009, 9:40:03 am
> UUID: 3a192ea2-e091-4b55-8e73-a5283c30deb7
> Ancestors: Kernel-ul.297
>
> cosmetic clean-up from pharo
> avoid a useless copy, and avoid inlining anySatisfy:
>
> Note that we reject: anySatisfy: references notEmpty
> We could as well select: allSatisfy: references isEmpty
> Affirmations are generally better understood than double negations :)
>
>
> =============== Diff against Kernel-ul.297 ===============
>
> Item was added:
> + ----- Method: DependentsArray class>>withAll: (in category 'instance creation') -----
> + withAll: aCollection
> +       | newInstance |
> +       newInstance := self basicNew: aCollection size.
> +       1 to: aCollection size do: [:i |
> +               newInstance basicAt: i put: (aCollection at: i)].
> +       ^newInstance!
>
> Item was added:
> + ----- Method: DependentsArray>>collect: (in category 'enumerating') -----
> + collect: aBlock
> +       "Refer to the comment in Collection|select:."
> +       | basicSize newSelf size dep selection |
> +       basicSize := self basicSize.
> +       newSelf := self species new: basicSize.
> +       size := 0.
> +       1 to: basicSize do: [:i |
> +               (dep := self basicAt: i) notNil ifTrue: [newSelf basicAt: (size := size+1) put: (aBlock value: dep)]].
> +       selection := self species new: size.
> +       selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
> +       ^selection!
>
> Item was added:
> + ----- Method: DependentsArray class>>with:with:with:with:with: (in category 'instance creation') -----
> + with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
> +       ^(self basicNew: 5)
> +               basicAt: 1 put: firstObject;
> +               basicAt: 2 put: secondObject;
> +               basicAt: 3 put: thirdObject;
> +               basicAt: 4 put: fourthObject;
> +               basicAt: 5 put: fifthObject;
> +               yourself!
>
> Item was added:
> + ClassTestCase subclass: #DependentsArrayTest
> +       instanceVariableNames: ''
> +       classVariableNames: ''
> +       poolDictionaries: ''
> +       category: 'Kernel-Objects-Tests'!
> +
> + !DependentsArrayTest commentStamp: '<historical>' prior: 0!
> + This class is to test the special implementation of DependentsArray.
> +
> + DependentsArray size will not count nil elements (the ones reclaimed by garbage collector).
> + Consequently, any message implemented with a construction like (1 to: self size do: [:i | ]) and sent to the dependents of any object might not behave as supposed to.!
>
> Item was added:
> + ----- Method: DependentsArray class>>with:with:with: (in category 'instance creation') -----
> + with: firstObject with: secondObject with: thirdObject
> +       ^(self basicNew: 3)
> +               basicAt: 1 put: firstObject;
> +               basicAt: 2 put: secondObject;
> +               basicAt: 3 put: thirdObject;
> +               yourself!
>
> Item was changed:
> + Collection weakSubclass: #DependentsArray
> - Array weakSubclass: #DependentsArray
>        instanceVariableNames: ''
>        classVariableNames: ''
>        poolDictionaries: ''
>        category: 'Kernel-Models'!
>
> + !DependentsArray commentStamp: 'nice 11/11/2009 20:30' prior: 0!
> + Act as an array of (weak) dependents of some object.
> +
> + When dependents are reclaimed, they are replaced by an UndefinedObject in the DependentsArray.
> + This is why instances of this class will take care to iterate only on non nil elements.
> + These nil also cause loops written as (1 to: self size do: [:i | (self at: i) doSomething]) to be inefficient.
> + This is because #size and #at: both require scanning for nils.
> + For this reason, DependentsArray though sequenceable, is not a subclass of SequenceableCollection.!
> - !DependentsArray commentStamp: '<historical>' prior: 0!
> - An array of (weak) dependents of some object.!
>
> Item was changed:
>  ----- Method: Behavior>>allUnreferencedInstanceVariables (in category 'user interface') -----
>  allUnreferencedInstanceVariables
>        "Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"
>
> +       ^ self allInstVarNames reject: [:ivn |
> +               | definingClass |
> -       | any definingClass |
> -
> -       ^ self allInstVarNames copy reject:
> -               [:ivn | any := false.
>                definingClass := self classThatDefinesInstanceVariable: ivn.
> +               definingClass withAllSubclasses anySatisfy: [:class |
> +                               (class whichSelectorsAccess: ivn asSymbol) notEmpty]]!
> -               definingClass withAllSubclasses do:
> -                       [:class |  any ifFalse:
> -                               [(class whichSelectorsAccess: ivn asSymbol) do:
> -                                       [:sel | sel isDoIt ifFalse: [any := true]]]].
> -                       any]!
>
> Item was added:
> + ----- Method: DependentsArray>>at: (in category 'accessing') -----
> + at: anIndex
> +       | basicSize counter dep |
> +       anIndex > 0 ifTrue: [
> +               basicSize := self basicSize.
> +               anIndex <= basicSize ifTrue: [
> +                       counter := 0.
> +                       1 to: basicSize do: [:i |
> +                               (dep := self basicAt: i) == nil
> +                                       ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^dep]]]]].
> +       self error: 'access with an index out of bounds'!
>
> Item was added:
> + ----- Method: DependentsArrayTest>>testAddingTwice (in category 'testing') -----
> + testAddingTwice
> +
> +       | test dep2 deps |
> +       test := Object new.
> +       dep2 := String with: $z with: $u with: $t.
> +
> +       test addDependent: String new.
> +       test addDependent: dep2.
> +
> +       Smalltalk garbageCollect. "this will make first dependent vanish, replaced by nil"
> +
> +       test addDependent: dep2.
> +
> +       deps := test dependents.
> +       self should: [deps asIdentitySet size = deps size] description: 'No object should be added twice in dependents'!
>
> Item was changed:
>  SystemOrganization addCategory: #'Kernel-Chronology'!
>  SystemOrganization addCategory: #'Kernel-Classes'!
>  SystemOrganization addCategory: #'Kernel-Methods'!
>  SystemOrganization addCategory: #'Kernel-Numbers'!
>  SystemOrganization addCategory: #'Kernel-Objects'!
>  SystemOrganization addCategory: #'Kernel-Processes'!
>  SystemOrganization addCategory: #'Kernel-Models'!
>  SystemOrganization addCategory: #'Kernel-Tests-ClassBuilder'!
> + SystemOrganization addCategory: #'Kernel-Objects-Tests'!
>
> Item was changed:
> + ----- Method: DependentsArray>>size (in category 'accessing') -----
> - ----- Method: DependentsArray>>size (in category 'copying') -----
>  size
> +       "count each non nil elements in self.
> +       Note: count: will use do: which will already have filtered out nil elements"
> +
> +       ^self count: [:each | true]!
> -       ^self inject: 0 into: [ :count :dep | dep ifNil: [ count ] ifNotNil: [ count + 1 ]]!
>
> Item was added:
> + ----- Method: DependentsArray>>first (in category 'accessing') -----
> + first
> +       self do: [:dep | ^dep].
> +       self error: 'this collection is empty'!
>
> Item was added:
> + ----- Method: DependentsArray>>reverseDo: (in category 'enumerating') -----
> + reverseDo: aBlock
> +       "Refer to the comment in Collection|do:."
> +       | dep |
> +       self basicSize to: 1 by: -1 do: [:i |
> +               (dep := self basicAt: i) ifNotNil: [aBlock value: dep]]!
>
> Item was changed:
>  ----- Method: DependentsArray>>do: (in category 'enumerating') -----
>  do: aBlock
> +       "Evaluate a Block on non nil elements of the receiver"
> -       "Refer to the comment in Collection|do:."
>        | dep |
>        1 to: self basicSize do:[:i|
> +               (dep := self basicAt: i) ifNotNil:[aBlock value: dep]].!
> -               (dep := self at: i) ifNotNil:[aBlock value: dep]].!
>
> Item was added:
> + ----- Method: DependentsArray class>>with:with:with:with:with:with: (in category 'instance creation') -----
> + with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
> +       ^(self basicNew: 6)
> +               basicAt: 1 put: firstObject;
> +               basicAt: 2 put: secondObject;
> +               basicAt: 3 put: thirdObject;
> +               basicAt: 4 put: fourthObject;
> +               basicAt: 5 put: fifthObject;
> +               basicAt: 6 put: sixthObject;
> +               yourself!
>
> Item was changed:
>  ----- Method: DependentsArray>>select: (in category 'enumerating') -----
>  select: aBlock
>        "Refer to the comment in Collection|select:."
> +       | basicSize newSelf size dep selection |
> +       basicSize := self basicSize.
> +       newSelf := self species new: basicSize.
> +       size := 0.
> +       1 to: basicSize do: [:i |
> +               ((dep := self basicAt: i) notNil and: [aBlock value: dep]) ifTrue: [newSelf basicAt: (size := size+1) put: dep]].
> +       selection := self species new: size.
> +       selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
> +       ^selection!
> -       | aStream |
> -       aStream := WriteStream on: (self species new: self size).
> -       self do:[:obj|
> -               (aBlock value: obj)
> -                       ifTrue: [aStream nextPut: obj]].
> -       ^ aStream contents!
>
> Item was added:
> + ----- Method: DependentsArray>>last (in category 'accessing') -----
> + last
> +       self reverseDo: [:dep | ^dep].
> +       self error: 'this collection is empty'!
>
> Item was added:
> + ----- Method: DependentsArray>>basicReplaceFrom:to:with:startingAt: (in category 'private') -----
> + basicReplaceFrom: start to: stop with: replacement startingAt: repStart
> +       "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
> +       <primitive: 105>
> +       start to: stop do: [:i |
> +               self basicAt: i put: (replacement basicAt: repStart - start + i)]!
>
> Item was added:
> + ----- Method: DependentsArrayTest>>testCanDiscardEdits (in category 'testing') -----
> + testCanDiscardEdits
> +       "self debug: #testCanDiscardEdits."
> +
> +       | anObject aView  |
> +       anObject := Object new.
> +       aView := StringHolderView new
> +               model: Transcript;
> +               window: (0 at 0 extent: 60 at 60);
> +               borderWidth: 1.
> +       aView hasUnacceptedEdits: true.
> +       anObject addDependent: Object new. "this entry should be garbage collected"
> +       anObject addDependent: aView.
> +
> +       Smalltalk garbageCollect. "force garbage collection"
> +
> +       self
> +               should: [anObject dependents size = 1]
> +               description: 'first dependent of anObject should have been collected, second should not'.
> +
> +       self
> +               shouldnt: [anObject canDiscardEdits]
> +               description: 'anObject cannot discard edits because aView is a dependent of anObject and aView has unaccepted edits'.!
>
> Item was added:
> + ----- Method: DependentsArray>>at:put: (in category 'accessing') -----
> + at: anIndex put: anObject
> +       | basicSize counter |
> +       anIndex > 0 ifTrue: [
> +               basicSize := self basicSize.
> +               anIndex <= basicSize ifTrue: [
> +                       counter := 0.
> +                       1 to: basicSize do: [:i |
> +                               (self basicAt: i) == nil
> +                                       ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^self basicAt: i put: anObject]]]]].
> +       self error: 'access with an index out of bounds'!
>
> Item was added:
> + ----- Method: DependentsArray class>>with:with: (in category 'instance creation') -----
> + with: firstObject with: secondObject
> +       ^(self basicNew: 2)
> +               basicAt: 1 put: firstObject;
> +               basicAt: 2 put: secondObject;
> +               yourself!
>
> Item was added:
> + ----- Method: DependentsArray class>>with: (in category 'instance creation') -----
> + with: anObject
> +       ^(self basicNew: 1) basicAt: 1 put: anObject; yourself!
>
> Item was changed:
>  ----- Method: DependentsArray>>copyWith: (in category 'copying') -----
>  copyWith: newElement
>        "Re-implemented to not copy any niled out dependents."
>        | copy i |
>        copy := self class new: self size + 1.
>        i := 0.
> +       self do: [:item | copy basicAt: (i:=i+1) put: item].
> +       copy basicAt: (i:=i+1) put: newElement.
> -       self do: [:item | copy at: (i:=i+1) put: item].
> -       copy at: (i:=i+1) put: newElement.
>        ^copy!
>
> Item was added:
> + ----- Method: DependentsArray class>>with:with:with:with: (in category 'instance creation') -----
> + with: firstObject with: secondObject with: thirdObject with: fourthObject
> +       ^(self basicNew: 4)
> +               basicAt: 1 put: firstObject;
> +               basicAt: 2 put: secondObject;
> +               basicAt: 3 put: thirdObject;
> +               basicAt: 4 put: fourthObject;
> +               yourself!
>
>
>



More information about the Squeak-dev mailing list