The Trunk: Tests-dtl.380.mcz

David T. Lewis uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-dtl.380.mcz

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

Name: Tests-dtl.380
Author: dtl
Time: 6 August 2017, 12:18:36.034473 pm
UUID: a7c7e81f-c7f5-425f-8301-2e289bde3da1
Ancestors: Tests-eem.379

CompiledCode and its subclasses are a special case, and are identified as class type #compiledMethod rather than #bytes. An MCClassDefinition should identify this type correctly, otherwise changes to these classes may not be saved and reloaded correctly.

Add tests to verify this for MCClassDefinition, and categorize the tests.

=============== Diff against Tests-eem.379 ===============

Item was changed:
  SystemOrganization addCategory: #'Tests-Bugs'!
  SystemOrganization addCategory: #'Tests-Compiler'!
  SystemOrganization addCategory: #'Tests-Dependencies'!
  SystemOrganization addCategory: #'Tests-Digital Signatures'!
  SystemOrganization addCategory: #'Tests-Environments'!
  SystemOrganization addCategory: #'Tests-Exceptions'!
  SystemOrganization addCategory: #'Tests-FilePackage'!
  SystemOrganization addCategory: #'Tests-Files'!
  SystemOrganization addCategory: #'Tests-Finalization'!
  SystemOrganization addCategory: #'Tests-Hex'!
  SystemOrganization addCategory: #'Tests-Installer-Core'!
  SystemOrganization addCategory: #'Tests-Localization'!
  SystemOrganization addCategory: #'Tests-Monticello'!
  SystemOrganization addCategory: #'Tests-Monticello-Mocks'!
  SystemOrganization addCategory: #'Tests-Monticello-Utils'!
  SystemOrganization addCategory: #'Tests-Object Events'!
  SystemOrganization addCategory: #'Tests-ObjectsAsMethods'!
  SystemOrganization addCategory: #'Tests-PrimCallController'!
  SystemOrganization addCategory: #'Tests-Release'!
  SystemOrganization addCategory: #'Tests-System-Object Storage'!
  SystemOrganization addCategory: #'Tests-System-Support'!
  SystemOrganization addCategory: #'Tests-Utilities'!
  SystemOrganization addCategory: #'Tests-VM'!
  SystemOrganization addCategory: #'Tests-System-Digital Signatures'!
  SystemOrganization addCategory: #'Tests-System-Preferences'!
- SystemOrganization addCategory: #'Tests-MonticelloMocks'!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>classAComment (in category 'running') -----
- ----- Method: MCClassDefinitionTest>>classAComment (in category 'as yet unclassified') -----
  classAComment
  ^ self class classAComment!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>creationMessage (in category 'running') -----
- ----- Method: MCClassDefinitionTest>>creationMessage (in category 'as yet unclassified') -----
  creationMessage
  ^ MessageSend
  receiver: MCClassDefinition
  selector: #name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp:!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>tearDown (in category 'running') -----
- ----- Method: MCClassDefinitionTest>>tearDown (in category 'as yet unclassified') -----
  tearDown
 
  super tearDown.
  Smalltalk at: 'MCMockClassC' ifPresent: [:c | c removeFromSystem]!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'as yet unclassified') -----
  testCannotLoad
  | d |
  d :=  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
  self should: [d load] raise: Error.
  self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testComparison (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testComparison (in category 'as yet unclassified') -----
  testComparison
  | d1 d2 d3 d4 |
  d1 := self mockClass: 'A' super: 'X'.
  d2 := self mockClass: 'A' super: 'Y'.
  d3 := self mockClass: 'B' super: 'X'.
  d4 := self mockClass: 'B' super: 'X'.
 
  self assert: (d1 isRevisionOf: d2).
  self deny: (d1 isSameRevisionAs: d2).
 
  self assert: (d3 isRevisionOf: d4).
  self assert: (d3 isSameRevisionAs: d4).
 
  self deny: (d1 isRevisionOf: d3).
  self deny: (d4 isRevisionOf: d2).!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testCreation (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testCreation (in category 'as yet unclassified') -----
  testCreation
  | d |
  d :=  self mockClassA asClassDefinition.
  self assert: d className = #MCMockClassA.
  self assert: d superclassName = #MCMock.
  self assert: d type = #normal.
  self assert: d category = self mockCategoryName.
  self assert: d instVarNames asArray = #('ivar').
  self assert: d classVarNames asArray = #('CVar').
  self assert: d classInstVarNames asArray = #().
  self assert: d comment isString.
  self assert: d comment = self classAComment.
  self assert: d commentStamp = self mockClassA organization commentStamp!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'as yet unclassified') -----
  testDefinitionString
  | d |
  d := self mockClassA asClassDefinition.
  self assert: d definitionString = self mockClassA definition.!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testEquals (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testEquals (in category 'as yet unclassified') -----
  testEquals
  | a b |
  a := self mockClass: 'ClassA' super: 'SuperA'.
  b := self mockClass: 'ClassA' super: 'SuperA'.
  self assert: a = b!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'as yet unclassified') -----
  testEqualsSensitivity
  | message a b defA args defB |
  message := self creationMessage.
  a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA)
  typeA 'A comment' 'A').
  b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB)
  typeB 'B comment' 'B').
 
  defA := message valueWithArguments: a.
  1 to: 8 do: [:index |
  args := a copy.
  args at: index put: (b at: index).
  defB := message valueWithArguments: args.
  self deny: defA = defB.]!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'testing - class type') -----
- ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'as yet unclassified') -----
  testKindOfSubclass
  {self mockClassA. String. ByteString. WideString. BlockClosure. WeakArray. BoxedFloat64. SmallFloat64. CompiledMethod. ByteArray. DoubleByteArray. IntegerArray. DoubleWordArray. }
  do: [:c |
  self assert: c asClassDefinition kindOfSubclass equals: c kindOfSubclass]!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledBlock (in category 'testing - class type') -----
+ testKindOfSubclassForCompiledBlock
+ "CompiledCode and its subclasses are a special case."
+ | classDef |
+ "CompiledBlock should be like CompiledMethod, both now are subclassed from CompiledCode"
+ classDef := self mockClass: #CompiledBlock super: #CompiledCode type: #bytes.
+ self assert: #compiledMethod equals: classDef type.
+ self assert: CompiledBlock typeOfClass equals: classDef type.
+ !

Item was added:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledCode (in category 'testing - class type') -----
+ testKindOfSubclassForCompiledCode
+ "CompiledCode and its subclasses are a special case."
+ | classDef |
+ "CompiledMethod is now a subclass of CompiledCode, which is also of type #compiledMethod"
+ classDef := self mockClass: #CompiledCode super: #ByteArray type: #bytes.
+ self assert: #compiledMethod equals: classDef type.
+ self assert: CompiledCode typeOfClass equals: classDef type.
+
+ !

Item was added:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledMethod (in category 'testing - class type') -----
+ testKindOfSubclassForCompiledMethod
+ "CompiledCode and its subclasses are a special case."
+ | classDef |
+ classDef := self mockClass: #CompiledMethod super: #CompiledCode type: #bytes.
+ self assert: #compiledMethod equals: classDef type.
+ self assert: CompiledMethod typeOfClass equals: classDef type.
+ !

Item was added:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclassForSocketAddress (in category 'testing - class type') -----
+ testKindOfSubclassForSocketAddress
+ "A subclass of ByteArray that is not treated specially"
+ | classDef |
+ classDef := self mockClass: #SocketAddress super: #ByteArray type: #bytes.
+ self assert: #bytes equals: classDef type.
+ self assert: SocketAddress typeOfClass equals: classDef type.
+
+ !

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'testing') -----
- ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'as yet unclassified') -----
  testLoadAndUnload
  | d c |
  d :=  self mockClass: 'MCMockClassC' super: 'Object'.
  d load.
  self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
  c := (Smalltalk classNamed: 'MCMockClassC').
  self assert: (c isKindOf: Class).
  self assert: c superclass = Object.
  self assert: c instVarNames isEmpty.
  self assert: c classVarNames isEmpty.
  self assert: c sharedPools isEmpty.
  self assert: c category = self mockCategoryName.
  self assert: c organization classComment = (self commentForClass: 'MCMockClassC').
  self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC').
  d unload.
  self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was changed:
  ----- Method: MCTestCase>>mockClass:super: (in category 'mocks') -----
  mockClass: className super: superclassName
+ ^ self mockClass: className super: superclassName type: #normal
+ !
- ^ MCClassDefinition
- name:  className
- superclassName:  superclassName
- category: self mockCategoryName
- instVarNames: #()
- classVarNames: #()
- poolDictionaryNames: #()
- classInstVarNames: #()
- type: #normal
- comment: (self commentForClass: className)
- commentStamp: (self commentStampForClass: className)!

Item was added:
+ ----- Method: MCTestCase>>mockClass:super:type: (in category 'mocks') -----
+ mockClass: className super: superclassName type: typeSymbol
+ ^ MCClassDefinition
+ name:  className
+ superclassName:  superclassName
+ category: self mockCategoryName
+ instVarNames: #()
+ classVarNames: #()
+ poolDictionaryNames: #()
+ classInstVarNames: #()
+ type: typeSymbol
+ comment: (self commentForClass: className)
+ commentStamp: (self commentStampForClass: className)!