Status: FixedWaitingToBePharoed
Owner: stephane.ducasse
Labels: Milestone-1.3 Difficulty-Easy
New issue 3424 by stephane.ducasse: Improved class Tests
http://code.google.com/p/pharo/issues/detail?id=3424
A new version of KernelTests was added to project The Inbox:
http://source.squeak.org/inbox/KernelTests-spd.149.mcz
==================== Summary ====================
Name: KernelTests-spd.149
Author: spd
Time: 4 December 2010, 1:33:50.265 pm
UUID: 89c23bef-103f-4b9d-885c-bcf19d6b6fa9
Ancestors: KernelTests-cmm.148
* refactored and extended ClassTest, including adding a test for
Class>>canFindWithoutEnvironment: (fixed in Kernel-spd.444 in inbox)
n.b. no conflicts with trunk as of 12/4/2010
=============== Diff against KernelTests-cmm.148 ===============
Item was changed:
TestCase subclass: #ClassTest
+ instanceVariableNames: 'className renamedName subClassName
anotherClassName class subclass anotherClass'
- instanceVariableNames: 'className renamedName'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
Item was added:
+ ----- Method: ClassTest classSide>>deleteClassNamed: (in
category 'setup') -----
+ deleteClassNamed: aString
+ | cl |
+ cl := Smalltalk at: aString ifAbsent: [^self].
+ cl removeFromChanges; removeFromSystemUnlogged
+ !
Item was removed:
- ----- Method: ClassTest>>deleteClass (in category 'setup') -----
- deleteClass
- | cl |
- cl := Smalltalk at: className ifAbsent: [^self].
- cl removeFromChanges; removeFromSystemUnlogged
- !
Item was removed:
- ----- Method: ClassTest>>deleteRenamedClass (in category 'setup') -----
- deleteRenamedClass
- | cl |
- cl := Smalltalk at: renamedName ifAbsent: [^self].
- cl removeFromChanges; removeFromSystemUnlogged
- !
Item was added:
+ ----- Method: ClassTest>>deleteTestClasses (in category 'setup') -----
+ deleteTestClasses
+
+ self class deleteClassNamed: class name.
+ self class deleteClassNamed: subclass name.
+ self class deleteClassNamed: renamedName.
+ self class deleteClassNamed: anotherClass name.
+ !
Item was changed:
----- Method: ClassTest>>setUp (in category 'setup') -----
setUp
+
- className := #TUTU.
renamedName := #RenamedTUTU.
+
+ self deleteTestClasses.
+
+ class := Object subclass: #TUTU
- self deleteClass.
- self deleteRenamedClass.
- Object subclass: className
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
+ category: 'KernelTests-Classes'.
+
+ subclass := class subclass: #SubTUTU
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'KernelTests-Classes'.
+
+ anotherClass := Object subclass: #AnotherClass
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'KernelTests-Classes'.!
- category: 'KernelTests-Classes'!
Item was added:
+ ----- Method: ClassTest>>superclass (in category 'accessing') -----
+ superclass
+
+ ^ class.!
Item was changed:
----- Method: ClassTest>>tearDown (in category 'setup') -----
tearDown
+
+ self deleteTestClasses.!
- self deleteClass.
- self deleteRenamedClass!
Item was added:
+ ----- Method: ClassTest>>testAddClassVarName (in category 'testing') -----
+ testAddClassVarName
+ "self run: #testAddClassVarName"
+
+ class addClassVarName: #MyShinyNewClassVar.
+ self assert: (class classVarNames anySatisfy: [ :name | name =
#MyShinyNewClassVar ]).
+
+ !
Item was added:
+ ----- Method: ClassTest>>testAddClassVarNameWithSameNameAsAGlobal (in
category 'testing') -----
+ testAddClassVarNameWithSameNameAsAGlobal
+ "self run: #testAddClassVarName"
+
+ self shouldnt: [ class addClassVarName: anotherClass name ] raise:
Exception.
+ self assert: (class classVarNames anySatisfy: [ :name | name =
anotherClass name ]).
+
+ !
Item was changed:
----- Method: ClassTest>>testAddInstVarName (in category 'testing') -----
testAddInstVarName
"self run: #testAddInstVarName"
+ class addInstVarName: 'x'.
+ self assert: (class instVarNames = #('x')).
+ class addInstVarName: 'y'.
+ self assert: (class instVarNames = #('x' 'y'))
- | tutu |
- tutu := Smalltalk at: #TUTU.
- tutu addInstVarName: 'x'.
- self assert: (tutu instVarNames = #('x')).
- tutu addInstVarName: 'y'.
- self assert: (tutu instVarNames = #('x' 'y'))
-
!
Item was added:
+ ----- Method: ClassTest>>testCanFindWithoutEnvironment (in
category 'testing') -----
+ testCanFindWithoutEnvironment
+ "self debug: #testCanFindWithoutEnvironment"
+ "self run: #testCanFindWithoutEnvironment"
+
+ self deny: (subclass canFindWithoutEnvironment:
#ClassVarInSuperclass).
+ self deny: (subclass canFindWithoutEnvironment:
#PoolVarInSuperclass).
+ self deny: (subclass canFindWithoutEnvironment: #ClassVar).
+ self deny: (subclass canFindWithoutEnvironment: #PoolVar).
+
+ subclass addClassVarName: 'ClassVar'.
+ self assert: (subclass canFindWithoutEnvironment: #ClassVar).
+
+ subclass addSharedPool: (Dictionary newFromPairs: #(PoolVar->5)).
+ self assert: (subclass canFindWithoutEnvironment: #PoolVar).
+
+ self superclass addClassVarName: 'ClassVarInSupersubclass'.
+ self assert: (subclass canFindWithoutEnvironment:
#ClassVarInSupersubclass).
+
+ self superclass addSharedPool: (Dictionary newFromPairs:
#(PoolVarInSupersubclass->5)).
+ self assert: (subclass canFindWithoutEnvironment:
#PoolVarInSupersubclass).!
Item was changed:
----- Method: ClassTest>>testRenaming (in category 'testing') -----
testRenaming
"self debug: #testRenaming"
"self run: #testRenaming"
+ | newMetaclassName |
- | oldName newMetaclassName class |
- oldName := className.
newMetaclassName := (renamedName, #' class') asSymbol.
- class := Smalltalk at: oldName.
class class compile: 'dummyMeth'.
class rename: renamedName.
self assert: class name = renamedName.
self assert: (ChangeSet current changedClassNames includes:
renamedName).
self assert: (ChangeSet current changedClassNames includes:
newMetaclassName).
!
