The Trunk: TraitsTests-pre.15.mcz

Patrick Rein uploaded a new version of TraitsTests to project The Trunk:
http://source.squeak.org/trunk/TraitsTests-pre.15.mcz

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

Name: TraitsTests-pre.15
Author: pre
Time: 20 November 2015, 3:00:52.59 pm
UUID: 3faad7d5-71f7-48d2-9ccb-4162d332c62a
Ancestors: TraitsTests-nice.14

Updates the Traits tests to reflect the changes to the trait composition operator evaluation order

=============== Diff against TraitsTests-nice.14 ===============

Item was changed:
  ----- Method: ClassTraitTest>>testConflictsAliasesAndExclusions (in category 'testing') -----
  testConflictsAliasesAndExclusions
  "conflict"
 
  self t1 classTrait compile: 'm2ClassSide: x ^99' classified: 'mycategory'.
  self assert: (self t1 classTrait includesLocalSelector: #m2ClassSide:).
  self assert: (self t5 classTrait >> #m2ClassSide:) isConflict.
  self assert: (self c2 class >> #m2ClassSide:) isConflict.
 
  "exclusion and alias"
  self assert: self t5 classSide traitComposition asString
  = 'T1 classTrait + T2 classTrait'.
  self t5 classSide
  uses: (self t1 classTrait @ { (#m2ClassSideAlias1: -> #m2ClassSide:) }
+ + (self t2 classTrait @ { (#m2ClassSideAlias2: -> #m2ClassSide:) } - { #m2ClassSide: })).
- + self t2 classTrait) @ { (#m2ClassSideAlias2: -> #m2ClassSide:) }
- - { #m2ClassSide: }.
  self deny: (self t5 classTrait >> #m2ClassSide:) isConflict.
  self deny: (self c2 class >> #m2ClassSide:) isConflict.
  self assert: (self c2 m2ClassSideAlias1: 13) = 99.
  self assert: (self c2 m2ClassSideAlias2: 13) = 13!

Item was changed:
  ----- Method: PureBehaviorTest>>testChangeSuperclass (in category 'testing-applying trait composition') -----
  testChangeSuperclass
  "self run: #testChangeSuperclass"
 
  "Test that when the superclass of a class is changed the non-local methods
  of the class sending super are recompiled to correctly store the new superclass."
 
  | aC2 newSuperclass |
  aC2 := self c2 new.
 
  "C1 is current superclass of C2"
  self assert: aC2 m51.
  self assert: self c2 superclass == self c1.
  self deny: (self c2 localSelectors includes: #m51).
  self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!"
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo).
 
 
  "change superclass of C2 from C1 to X"
  newSuperclass := self createClassNamed: #X superclass: Object uses: {}.
  newSuperclass
  subclass: self c2 name
  uses: self c2 traitComposition
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: self c2 category.
 
  self assert: self c2 superclass == newSuperclass.
 
  newSuperclass compile: 'foo ^17'.
  self assert: aC2 m51 = 17.
  self deny: (self c2 localSelectors includes: #m51).
 
  self c2 compile: 'm51 ^19'.
  self assert: aC2 m51 = 19.
 
  self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!"
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo m51).
 
  "change superclass of C2 back to C1"
  self c1
  subclass: self c2 name
  uses: self c2 traitComposition
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: self c2 category.
 
  self assert: (aC2 m51 = 19).
  self assert: self c2 superclass == self c1.
  self assert: (self c2 localSelectors includes: #m51).
  self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!"
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo m51).
  !

Item was changed:
  ----- Method: PureBehaviorTest>>testPropagationWhenTraitCompositionModifications (in category 'testing-applying trait composition') -----
  testPropagationWhenTraitCompositionModifications
  "Test that the propagation mechanism works when
  setting new traitCompositions."
 
  self assert: self c2 methodDict size = 9. "2 + (3+(3+2))-1"
 
  "removing methods"
  self createTraitNamed: #T5
+ uses: self t1 + (self t2 - { #m21. #m22 }).
- uses: self t1 + self t2 - { #m21. #m22 }.
  self assert: self c2 methodDict size = 7.
 
  "adding methods"
  self createTraitNamed: #T2 uses: self t3.
  self assert: self c2 methodDict size = 10.
  self assert: (self c2 methodDict keys includesAllOf: #(#m31 #m32 #m33 ))!

Item was changed:
  ----- Method: PureBehaviorTest>>testReshapeClass (in category 'testing-applying trait composition') -----
  testReshapeClass
  "self run: #testReshapeClass"
 
  "Ensure that reshaping a class has no impact on its traits"
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo).
 
  self c2 addInstVarName: 'foobar'.
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo).
 
  self c2 removeInstVarName: 'foobar'.
 
+ self assert: self c2 traitCompositionString = '(T5 - {#m11})'.
- self assert: self c2 traitCompositionString = 'T5 - {#m11}'.
  self assert: self c2 selectors sort =  #(bar foo m12 m13 m21 m22 m51 m52 m53).
  self assert: self c2 localSelectors sort =  #(bar foo).
  !

Item was changed:
  ----- Method: TraitCompositionTest>>testInvalidComposition (in category 'testing-basic') -----
  testInvalidComposition
  self shouldnt: [self t1 @ { (#a -> #b) } @ { (#x -> #y) }]
  raise: TraitCompositionException.
  self shouldnt: [(self t1 + self t2) @ { (#a -> #b) } @ { (#x -> #y) }]
  raise: TraitCompositionException.
  self shouldnt: [self t1 - { #a } - { #b }] raise: TraitCompositionException.
  self shouldnt: [self t1 + self t2 - { #a } - { #b }]
  raise: TraitCompositionException.
  self should: [(self t1 - { #x }) @ { (#a -> #b) }]
  raise: TraitCompositionException.
+ self should: [(self t1 + (self t2 - { #x } @ { (#a -> #b) }))]
- self should: [(self t1 + self t2 - { #x }) @ { (#a -> #b) }]
  raise: TraitCompositionException.
  self should: [self t1 + self t1] raise: TraitCompositionException.
  self should: [(self t1 + self t2) @ { (#a -> #b) } + self t1]
  raise: TraitCompositionException.
  self should: [self t1 @ { (#a -> #m11). (#a -> #m12) }]
  raise: TraitCompositionException.
  self should: [self t1 @ { (#a -> #m11). (#b -> #a) }]
  raise: TraitCompositionException!

Item was changed:
  ----- Method: TraitCompositionTest>>testPrinting (in category 'testing-basic') -----
  testPrinting
  | composition1 composition2 |
+ composition1 := ((self t1 - { #a } + (self t2 @ { (#z -> #c) } - { #b. #c }))
+ + (self t3 - { #d. #e })
+ + (self t4 @ { (#x -> #a). (#y -> #b) })).
+ composition2 := (self t4 @ { (#x -> #a). (#y -> #b) }) + (self t1 - { #a })
+ + (self t3 - { #d. #e })
+ + (self t2 - { #b. #c }).
- composition1 := ((self t1 - { #a } + self t2) @ { (#z -> #c) } - { #b. #c }
- + self t3 - { #d. #e }
- + self t4) @ { (#x -> #a). (#y -> #b) }.
- composition2 := self t4 @ { (#x -> #a). (#y -> #b) } + self t1 - { #a }
- + self t3 - { #d. #e }
- + self t2 - { #b. #c }.
  self assertPrints: composition1 printString
+ like: '(T1 - {#a}) + ((T2 @ {#z->#c}) - {#b. #c}) + (T3 - {#d. #e}) + (T4 @ {#x->#a. #y->#b})'.
- like: 'T1 - {#a} + T2 @ {#z->#c} - {#b. #c} + T3 - {#d. #e} + T4 @ {#x->#a. #y->#b}'.
  self assertPrints: composition2 printString
+ like: '(T4 @ {#x->#a. #y->#b}) + (T1 - {#a}) + (T3 - {#d. #e}) + (T2 - {#b. #c})'!
- like: 'T4 @ {#x->#a. #y->#b} + T1 - {#a} + T3 - {#d. #e} + T2 - {#b. #c}'!

Item was changed:
  ----- Method: TraitFileOutTest>>setUp (in category 'running') -----
  setUp
  super setUp.
  SystemOrganization addCategory: self categoryName.
 
  td := self createTraitNamed: #TD uses: {}.
  td compile: 'd' classified: #cat1.
  tc := self createTraitNamed: #TC uses: td.
  tc compile: 'c' classified: #cat1.
  tb := self createTraitNamed: #TB uses: td.
  tb compile: 'b' classified: #cat1.
+ ta := self createTraitNamed: #TA uses: tb + ((tc @ {#cc->#c}) - {#c}).
- ta := self createTraitNamed: #TA uses: tb + tc @ {#cc->#c} - {#c}.
  ta compile: 'a' classified: #cat1.
 
  ca := self createClassNamed: #CA superclass: Object uses: {}.
  ca compile: 'ca' classified: #cat1.
  cb := self createClassNamed: #CB superclass: ca uses: ta.
  cb compile: 'cb' classified: #cat1.
 
  "make the class of cb also use tc:"
  cb class uses: ta classTrait + tc instanceVariableNames: ''.!

Item was changed:
  ----- Method: TraitFileOutTest>>testFileOutCategory (in category 'testing') -----
  testFileOutCategory
  "File out whole system category, delete all classes and traits and then
  file them in again."
 
  "self run: #testFileOutCategory"
 
  SystemOrganization fileOutCategory: self categoryName.
  SystemOrganization removeSystemCategory: self categoryName.
  self deny: (Smalltalk globals keys includesAnyOf: #(CA CB TA TB TC TD)).
 
  self fileIn: self categoryName , '.st'..
 
  self assert: (Smalltalk globals keys includesAllOf: #(CA CB TA TB TC TD)).
 
  ta := Smalltalk at: #TA.
  self assert: (ta isKindOf: Trait).
+ self assert: 'TB + ((TC @ {#cc->#c}) - {#c})' equals: ta traitComposition asString.
- self assert: 'TB + TC @ {#cc->#c} - {#c}' equals: ta traitComposition asString.
  self assert: (ta methodDict keys includesAllOf: #(a b cc)).
 
  cb := Smalltalk at: #CB.
  self assert: (cb isKindOf: Class).
  self assert: 'TA' equals: cb traitComposition asString.
  self assert: (cb methodDict keys includesAllOf: #(cb a b cc)).
 
  "test classSide traitComposition of CB"
 
  self assert: 'TA classTrait + TC' equals: cb classSide traitComposition asString.
  self assert: (cb classSide methodDict keys includesAllOf: #(d c))
  !

Item was changed:
  ----- Method: TraitFileOutTest>>testFileOutTrait (in category 'testing') -----
  testFileOutTrait
  "fileOut trait T6, remove it from system and then file it in again"
 
  "self run: #testFileOutTrait"
 
  | fileName |
  self t6 compile: 'localMethod: argument ^argument'.
  self t6 classSide compile: 'localClassSideMethod: argument ^argument'.
  self t6 fileOut.
  fileName := self t6 asString , '.st'.
  self resourceClassesAndTraits remove: self t6.
  self t6 removeFromSystem.
 
  self fileIn: fileName.
 
  self assert: (Smalltalk includesKey: #T6).
  TraitsResource current t6: (Smalltalk at: #T6).
  self resourceClassesAndTraits add: self t6.
  self assert: (self t6 isKindOf: Trait).
+ self assert: 'T1 + (T2 @ {#m22Alias->#m22})' equals: self t6 traitComposition asString.
- self assert: 'T1 + T2 @ {#m22Alias->#m22}' equals: self t6 traitComposition asString.
  self assert: (self t6 methodDict keys includesAllOf: #(
  #localMethod:
  #m11
  #m12
  #m13
  #m21
  #m22
  #m22Alias
  )).
  self assert: 2 equals: self t6 classSide methodDict size.
  self assert: (self t6 classSide methodDict keys includes: #localClassSideMethod:) description: 'Missing selector #localClassSideMethod:'.
  self assert: (self t6 classSide methodDict keys includes: #m2ClassSide:) description: 'Missing selector #m2ClassSide:'.!

Item was changed:
  ----- Method: TraitTest>>testPrinting (in category 'testing') -----
  testPrinting
  self assertPrints: self t6 definition
  like: 'Trait named: #T6
+ uses: T1 + (T2 @ {#m22Alias->#m22})
- uses: T1 + T2 @ {#m22Alias->#m22}
  category: ''TraitsTests-Kernel'''!

Item was changed:
  ----- Method: TraitsResource>>setUp (in category 'as yet unclassified') -----
  setUp
  "Please note, that most tests rely on this setup of traits and
  classes - and that especially the order of the definitions matters."
  "SetUpCount := SetUpCount + 1."
 
  dirty := false.
  SystemChangeNotifier uniqueInstance doSilently:
  [self t1: (self createTraitNamed: #T1
  uses: { }).
  self t1 comment: 'I am the trait T1'.
  self t2: (self createTraitNamed: #T2
  uses: { }).
  self t2 compile: 'm21 ^21' classified: #cat1.
  self t2 compile: 'm22 ^22' classified: #cat2.
  self t2 classSide compile: 'm2ClassSide: a ^a'.
  self t3: (self createTraitNamed: #T3
  uses: { }).
  self t3 compile: 'm31 ^31' classified: #cat1.
  self t3 compile: 'm32 ^32' classified: #cat2.
  self t3 compile: 'm33 ^33' classified: #cat3.
  self t4: (self createTraitNamed: #T4
  uses: { (self t1). (self t2) }).
  self t4 compile: 'm11 ^41' classified: #catX. "overrides T1>>m11"
  self t4 compile: 'm42 ^42' classified: #cat2.
  self t5: (self createTraitNamed: #T5 uses: self t1 + self t2).
  self t5 compile: 'm51 ^super foo' classified: #cat1.
  self t5 compile: 'm52 ^ self class bar' classified: #cat1.
  self t5 compile: 'm53 ^ self class bar' classified: #cat1.
  self t6: (self createTraitNamed: #T6
+ uses: (self t1 + (self t2 @ { (#m22Alias -> #m22) }))).
- uses: (self t1 + self t2) @ { (#m22Alias -> #m22) }).
  self c1: (self
  createClassNamed: #C1
  superclass: Object
  uses: { }).
  self c1 compile: 'foo ^true' classified: #accessing.
  self t1 compile: 'm11 ^11' classified: #cat1.
  self t1 compile: 'm12 ^12' classified: #cat2.
  self t1 compile: 'm13 ^self m12' classified: #cat3.
  self c2: (self
  createClassNamed: #C2
  superclass: self c1
  uses: self t5 - { #m11 }).
  self c2 compile: 'foo ^false' classified: #private.
  self c2 compile: 'bar ^self foo' classified: #private.
  self setUpTrivialRequiresFixture.
  self setUpTwoLevelRequiresFixture.
  self setUpTranslatingRequiresFixture].
  SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #codeChangedEvent:!