[Pkg] Squeak3.10bc: MorphicTests-kph.8.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:48:50 UTC 2008
A new version of MorphicTests was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/MorphicTests-kph.8.mcz
==================== Summary ====================
Name: MorphicTests-kph.8
Author: kph
Time: 13 December 2008, 4:48:48 am
UUID: fafb6e88-8ae2-41ae-987f-5ebb22585ce4
Ancestors: MorphicTests-edc.7
Saved from SystemVersion
==================== Snapshot ====================
SystemOrganization addCategory: #'MorphicTests-Basic'!
SystemOrganization addCategory: #'MorphicTests-Kernel'!
SystemOrganization addCategory: #'MorphicTests-Text Support'!
SystemOrganization addCategory: #'MorphicTests-Widgets'!
SystemOrganization addCategory: #'MorphicTests-Worlds'!
HashAndEqualsTestCase subclass: #TextAnchorTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Text Support'!
----- Method: TextAnchorTest>>setUp (in category 'initialize-release') -----
setUp
super setUp.
prototypes
add: (TextAnchor new anchoredMorph: RectangleMorph new initialize);
add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) !
HashAndEqualsTestCase subclass: #TextLineTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Text Support'!
----- Method: TextLineTest>>setUp (in category 'initialize-release') -----
setUp
super setUp.
prototypes
add: (TextLine
start: 1
stop: 50
internalSpaces: 2
paddingWidth: 1) !
Morph subclass: #TestInWorldMorph
instanceVariableNames: 'intoWorldCount outOfWorldCount'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Kernel'!
!TestInWorldMorph commentStamp: 'sd 6/5/2005 10:25' prior: 0!
Helper class for MorphTest!
----- Method: TestInWorldMorph>>initialize (in category 'as yet unclassified') -----
initialize
super initialize.
outOfWorldCount := intoWorldCount := 0.!
----- Method: TestInWorldMorph>>intoWorld: (in category 'as yet unclassified') -----
intoWorld: aWorld
aWorld ifNil:[^self].
super intoWorld: aWorld.
intoWorldCount := intoWorldCount + 1.
!
----- Method: TestInWorldMorph>>intoWorldCount (in category 'as yet unclassified') -----
intoWorldCount
^intoWorldCount!
----- Method: TestInWorldMorph>>outOfWorld: (in category 'as yet unclassified') -----
outOfWorld: aWorld
aWorld ifNil:[^self].
super outOfWorld: aWorld.
outOfWorldCount := outOfWorldCount + 1.
!
----- Method: TestInWorldMorph>>outOfWorldCount (in category 'as yet unclassified') -----
outOfWorldCount
^outOfWorldCount!
TestCase subclass: #BalloonFontTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Widgets'!
----- Method: BalloonFontTest>>testDefaultFont (in category 'tests') -----
testDefaultFont
"(self selector: #testDefaultFont) debug"
self assert: RectangleMorph new balloonFont = BalloonMorph balloonFont.
self assert: RectangleMorph new defaultBalloonFont = BalloonMorph balloonFont.!
----- Method: BalloonFontTest>>testSpecificFont (in category 'tests') -----
testSpecificFont
"(self selector: #testSpecificFont) debug"
| aMorph |
aMorph := RectangleMorph new.
self assert: RectangleMorph new balloonFont = BalloonMorph balloonFont.
self assert: RectangleMorph new defaultBalloonFont = BalloonMorph balloonFont.
aMorph
balloonFont: (StrikeFont familyName: #ComicPlain size: 19).
self assert: aMorph balloonFont
= (StrikeFont familyName: #ComicPlain size: 19).
"The next test is horrible because I do no know how to access the font
with the appropiate interface"
self assert: (((BalloonMorph getTextMorph: 'lulu' for: aMorph) text runs at: 1)
at: 1) font
= (StrikeFont familyName: #ComicPlain size: 19)!
TestCase subclass: #MCPTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Kernel'!
----- Method: MCPTest>>defaultBounds (in category 'constants') -----
defaultBounds
"the default bounds for morphs"
^ 0 @ 0 corner: 50 @ 40 !
----- Method: MCPTest>>defaultTop (in category 'constants') -----
defaultTop
"the default top for morphs"
^ self defaultBounds top !
----- Method: MCPTest>>testIsMorphicModel (in category 'tests') -----
testIsMorphicModel
"test isMorphicModel"
self deny: Object new isMorphicModel.
self deny: Morph new isMorphicModel.
self assert: MorphicModel new isMorphicModel.
!
----- Method: MCPTest>>testIsSystemWindow (in category 'tests') -----
testIsSystemWindow
"test isSystemWindow"
self deny: Object new isSystemWindow.
self assert: SystemWindow new isSystemWindow.
self assert: WorldWindow new isSystemWindow.!
----- Method: MCPTest>>testTop (in category 'tests') -----
testTop
"test the #top: messages and its consequences"
| morph factor newTop newBounds |
morph _ Morph new.
""
factor _ 10.
newTop _ self defaultTop + factor.
newBounds _ self defaultBounds translateBy: 0 @ factor.
""
morph top: newTop.
""
self assert: morph top = newTop;
assert: morph bounds = newBounds!
TestCase subclass: #MorphTest
instanceVariableNames: 'morph world'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Kernel'!
!MorphTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Morph. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
MorphTest subclass: #CircleMorphTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Basic'!
!CircleMorphTest commentStamp: 'tlk 5/21/2006 14:16' prior: 0!
A CircleMorphTest is a subclass of MorphTest. It was first implemented when removing some unused and broken functionality.
My fixtures are morph, a CircleMorph and world.
!
----- Method: CircleMorphTest>>setUp (in category 'initialize-release') -----
setUp
morph := CircleMorph new!
----- Method: MorphTest>>getWorld (in category 'initialize-release') -----
getWorld
^ world
ifNil: [world := Project newMorphic world]!
----- Method: MorphTest>>setUp (in category 'initialize-release') -----
setUp
morph := Morph new!
----- Method: MorphTest>>tearDown (in category 'initialize-release') -----
tearDown
morph delete.
world
ifNotNil: [Project deletingProject: world project]!
----- Method: MorphTest>>testIntoWorldCollapseOutOfWorld (in category 'testing - into/outOf World') -----
testIntoWorldCollapseOutOfWorld
| m1 m2 collapsed |
"Create the guys"
m1 := TestInWorldMorph new.
m2 := TestInWorldMorph new.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
"add them to basic morph"
morph addMorphFront: m1.
m1 addMorphFront: m2.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
"open the guy"
morph openInWorld.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
"collapse it"
collapsed := CollapsedMorph new beReplacementFor: morph.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 1).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 1).
"expand it"
collapsed collapseOrExpand.
self assert: (m1 intoWorldCount = 2).
self assert: (m1 outOfWorldCount = 1).
self assert: (m2 intoWorldCount = 2).
self assert: (m2 outOfWorldCount = 1).
"delete it"
morph delete.
self assert: (m1 intoWorldCount = 2).
self assert: (m1 outOfWorldCount = 2).
self assert: (m2 intoWorldCount = 2).
self assert: (m2 outOfWorldCount = 2).
!
----- Method: MorphTest>>testIntoWorldDeleteOutOfWorld (in category 'testing - into/outOf World') -----
testIntoWorldDeleteOutOfWorld
| m1 m2 |
"Create the guys"
m1 := TestInWorldMorph new.
m2 := TestInWorldMorph new.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
morph addMorphFront: m1.
m1 addMorphFront: m2.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
morph openInWorld.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
morph delete.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 1).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 1).
!
----- Method: MorphTest>>testIntoWorldTransferToNewGuy (in category 'testing - into/outOf World') -----
testIntoWorldTransferToNewGuy
| m1 m2 |
"Create the guys"
m1 := TestInWorldMorph new.
m2 := TestInWorldMorph new.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
morph addMorphFront: m1.
m1 addMorphFront: m2.
self assert: (m1 intoWorldCount = 0).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 0).
self assert: (m2 outOfWorldCount = 0).
morph openInWorld.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
morph addMorphFront: m2.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
morph addMorphFront: m1.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
m2 addMorphFront: m1.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 0).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 0).
morph delete.
self assert: (m1 intoWorldCount = 1).
self assert: (m1 outOfWorldCount = 1).
self assert: (m2 intoWorldCount = 1).
self assert: (m2 outOfWorldCount = 1).
!
----- Method: MorphTest>>testIsMorph (in category 'testing - classification') -----
testIsMorph
self assert: (morph isMorph).!
----- Method: MorphTest>>testOpenInWorld (in category 'testing - initialization') -----
testOpenInWorld
self shouldnt: [morph openInWorld] raise: Error.!
----- Method: MorphTest>>testOverlapAny (in category 'testing - etoys') -----
testOverlapAny
"self debug: #testOverlapAny"
| p1 p2 |
p1 _ Morph new assuredPlayer.
p2 _ EllipseMorph new assuredPlayer.
"Same position"
p1 costume position: 0 at 0.
p2 costume position: 0 at 0.
self assert: (p1 overlapsAny: p2).
"Different position"
p1 costume position: 0 at 0.
p2 costume position: 500 at 0.
self assert: (p1 overlapsAny: p2) not.!
----- Method: MorphTest>>testOverlapAnyDeletedPlayer (in category 'testing - etoys') -----
testOverlapAnyDeletedPlayer
"self debug: #testOverlapAnyDeletedPlayer"
| me friend sibling |
me := Morph new assuredPlayer assureUniClass; yourself.
friend := EllipseMorph new assuredPlayer assureUniClass; yourself.
sibling := friend getNewClone.
sibling costume delete.
self getWorld addMorph: me costume.
"Same position but deleted"
me costume position: 0 @ 0.
friend costume position: 0 @ 0.
sibling costume position: 0 @ 0.
self assert: (me overlapsAny: friend) not.
self assert: (me overlapsAny: sibling) not!
----- Method: MorphTest>>testOverlapAnyScriptedPlayer (in category 'testing - etoys') -----
testOverlapAnyScriptedPlayer
"self debug: #testOverlapAnyScriptedPlayer"
| me friend other sibling |
me := Morph new assuredPlayer assureUniClass; yourself.
friend := EllipseMorph new assuredPlayer assureUniClass; yourself.
sibling := friend getNewClone.
other := EllipseMorph new assuredPlayer assureUniClass; yourself.
self getWorld addMorph: me costume;
addMorph: friend costume;
addMorph: other costume;
addMorph: sibling costume.
"myself"
self assert: (me overlapsAny: me) not.
"Same position with sibling"
me costume position: 0 @ 0.
friend costume position: 500 @ 0.
other costume position: 500 @ 0.
sibling costume position: 0 at 0.
self assert: (me overlapsAny: friend).
"Different position with sibling but same class"
me costume position: 0 @ 0.
friend costume position: 500 @ 0.
sibling costume position: 500@ 0.
other costume position: 0 @ 0.
self assert: (me overlapsAny: friend) not!
----- Method: MorphTest>>testOverlapAnyUnscriptedPlayer (in category 'testing - etoys') -----
testOverlapAnyUnscriptedPlayer
"self debug: #testOverlapAnyUnscriptedPlayer"
| p1 p2 p3 |
p1 := Morph new assuredPlayer.
p2 := EllipseMorph new assuredPlayer.
p3 := EllipseMorph new assuredPlayer.
self getWorld addMorph: p1 costume;
addMorph: p2 costume;
addMorph: p3 costume.
"Same class, same position"
p1 costume position: 0 @ 0.
p2 costume position: 500 @ 0.
p3 costume position: 0 @ 0.
self
assert: (p1 overlapsAny: p2).
"Same class, different position"
p1 costume position: 0 @ 0.
p2 costume position: 1000 @ 0.
p3 costume position: 500 @ 0.
self assert: (p1 overlapsAny: p2) not.
!
TestCase subclass: #TileMorphTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Basic'!
----- Method: TileMorphTest>>testArrowAction (in category 'testing') -----
testArrowAction
"self debug: #testArrowAction"
| dummy tile |
dummy _ Morph new.
tile _ TileMorph new setOperator: '+'.
dummy addMorph: tile.
tile arrowAction: 1.
self assert: tile codeString = '-'.
tile _ TileMorph new setOperator: '<'.
dummy addMorph: tile.
tile arrowAction: 1.
"Because receiver is not tile"
self assert: tile codeString = '='.
tile _ true newTileMorphRepresentative.
dummy addMorph: tile.
tile arrowAction: 1.
self assert: tile codeString = '(false)'.
!
----- Method: TileMorphTest>>testAssignmentTile (in category 'testing') -----
testAssignmentTile
"self debug: #testAssignmentTile"
| player viewer tile phrase |
player _ Morph new assuredPlayer.
viewer _ CategoryViewer new invisiblySetPlayer: player.
viewer makeSetter: #(#getX #Number) event: nil from: player costume.
phrase _ ActiveHand firstSubmorph.
ActiveHand removeAllMorphs.
tile _ phrase submorphs second.
self assert: tile codeString = 'setX: '.
tile arrowAction: 1.
self assert: tile codeString = 'setX: self getX + '.
!
----- Method: TileMorphTest>>testSoundTile (in category 'testing') -----
testSoundTile
"self debug: #testSoundTile"
| tile dummy |
dummy _ Morph new.
tile _ SoundTile new literal: 'croak'.
dummy addMorph: tile.
tile arrowAction: 1.
self assert: tile codeString = '(''horn'')'.
!
ClassTestCase subclass: #PasteUpMorphTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Worlds'!
!PasteUpMorphTest commentStamp: '<historical>' prior: 0!
I am a TestCase for PasteUpMorph.!
----- Method: PasteUpMorphTest>>testCursorWrapped (in category 'tests') -----
testCursorWrapped
"self debug: #testCursorWrapped"
| holder |
holder := PasteUpMorph new.
self assert: holder cursor = 1.
holder cursorWrapped: 2.
self assert: holder cursor = 1.
holder addMorph: Morph new;
addMorph: Morph new;
addMorph: Morph new.
holder cursorWrapped: 3.
self assert: holder cursor = 3.
holder cursorWrapped: 5.
self assert: holder cursor = 2.
holder cursorWrapped: 0.
self assert: holder cursor = 3.
holder cursorWrapped: -1.
self assert: holder cursor = 2.!
----- Method: PasteUpMorphTest>>testCursorWrappedWithFraction (in category 'tests') -----
testCursorWrappedWithFraction
"self debug: #testCursorWrappedWithFraction"
| holder |
holder := PasteUpMorph new.
holder addMorph: Morph new;
addMorph: Morph new;
addMorph: Morph new.
holder cursorWrapped: 3.5.
self assert: holder cursor = 3.5.
holder cursorWrapped: 5.5.
self assert: holder cursor = 2.5.
holder cursorWrapped: 0.5.
self assert: holder cursor = 3.5.
holder cursorWrapped: -0.5.
self assert: holder cursor = 2.5.!
----- Method: PasteUpMorphTest>>testGridToGradient (in category 'tests') -----
testGridToGradient
"A trivial test for checking that you can change from a grid to a
gradient background. A recent [FIX] will make this pass."
| pum |
pum _ PasteUpMorph new.
pum setStandardTexture.
"The following should fail without the fix"
self
shouldnt: [pum gradientFillColor: Color red]
raise: MessageNotUnderstood!
----- Method: PasteUpMorphTest>>testPlayWithMe1Romoval (in category 'tests') -----
testPlayWithMe1Romoval
"A trivial test for checking that PlayWithMe classes are all removed"
self deny: ( Smalltalk hasClassNamed: 'PlayWithMe1' ) .!
ClassTestCase subclass: #SimpleSwitchMorphTest
instanceVariableNames: 'testSwitch'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Widgets'!
!SimpleSwitchMorphTest commentStamp: '<historical>' prior: 0!
I test the behavior of SimpleSwitchMorph!
----- Method: SimpleSwitchMorphTest>>classToBeTested (in category 'as yet unclassified') -----
classToBeTested
^ SimpleSwitchMorph !
----- Method: SimpleSwitchMorphTest>>setUp (in category 'as yet unclassified') -----
setUp
super setUp.
testSwitch := SimpleSwitchMorph new!
----- Method: SimpleSwitchMorphTest>>testName (in category 'as yet unclassified') -----
testName
self assert: testSwitch externalName = 'SimpleSwitch'!
----- Method: SimpleSwitchMorphTest>>testState (in category 'as yet unclassified') -----
testState
self assert: testSwitch isOff.
self deny: testSwitch isOn.
testSwitch toggleState.
self assert: testSwitch isOn.
self deny: testSwitch isOff!
----- Method: SimpleSwitchMorphTest>>testSwitching (in category 'as yet unclassified') -----
testSwitching
testSwitch setSwitchState: false.
self assert: testSwitch isOff.
self assert: testSwitch color = testSwitch offColor.
testSwitch setSwitchState: true.
self assert: testSwitch isOn.
self assert: testSwitch color = testSwitch onColor.!
ClassTestCase subclass: #TextMorphTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicTests-Basic'!
----- Method: TextMorphTest>>testInitialize (in category 'testing') -----
testInitialize
"For now, just make sure initialization doesn't throw exception"
self shouldnt: [TextMorph initialize] raise: Error.!
More information about the Packages
mailing list