'From VisualWorks®, Release 3.0 of February 5, 1998 on May 19, 1999 at 11:03:14 am'!

TestCase subclass: #RankTestCase
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Ranks'!


!RankTestCase methodsFor: 'running'!

testBadRank
	self should: [ArmyRank named: 'sissy'] raise: self errorSignal!

testGeneralNotUnderPrivate
	self shouldnt: [ArmyRank general < ArmyRank private]!

testNavy
	self should: [NavyRank seaman < NavyRank captain]!

testPrivate
	self should: [ArmyRank private = ArmyRank private]!

testPrivateUnderGeneral
	self should: [ArmyRank private < ArmyRank general]!

testUncomparable
	self should: [ArmyRank captain < NavyRank captain] raise: self errorSignal! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RankTestCase class
	instanceVariableNames: ''!


!RankTestCase class methodsFor: 'running'!

run
	| test |
	test := TestSuite named: 'Military Ranks'.
	test addTestCases: self testCases.
	^test run! !

!RankTestCase class methodsFor: 'examples'!

testCases
	| result |
	result := OrderedCollection new.
	result add: (self selector: #testPrivate).
	result add: (self selector: #testBadRank).
	result add: (self selector: #testUncomparable).
	result add: (self selector: #testPrivateUnderGeneral).
	result add: (self selector: #testGeneralNotUnderPrivate).
	result add: (self selector: #testNavy).
	^result! !