[Pkg] Installer: KernelTests-dc.74.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sun Sep 28 13:56:11 UTC 2008
A new version of KernelTests was added to project Installer:
http://www.squeaksource.com/Installer/KernelTests-dc.74.mcz
==================== Summary ====================
Name: KernelTests-dc.74
Author: dc
Time: 28 September 2008, 3:55:30 pm
UUID: 1df204cd-ab1f-4f38-8c19-585464b3380f
Ancestors: KernelTests-marcus.denker.73
- Categorize BehaviorTest>>testBinding
==================== Snapshot ====================
SystemOrganization addCategory: #'KernelTests-Chronology'!
SystemOrganization addCategory: #'KernelTests-Classes'!
SystemOrganization addCategory: #'KernelTests-Methods'!
SystemOrganization addCategory: #'KernelTests-Numbers'!
SystemOrganization addCategory: #'KernelTests-Objects'!
SystemOrganization addCategory: #'KernelTests-Processes'!
TestCase subclass: #BasicBehaviorClassMetaclassTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
!BasicBehaviorClassMetaclassTest commentStamp: '<historical>' prior: 0!
This class contains some tests regarding the classes
Behavior
ClassDescription
Class
Metaclass
---
!
----- Method: BasicBehaviorClassMetaclassTest>>testBehaviorClassClassDescriptionMetaclassHierarchy (in category 'testing') -----
testBehaviorClassClassDescriptionMetaclassHierarchy
"self run: #testBehaviorClassClassDescriptionMetaclassHierarchy"
self assert: Class superclass == ClassDescription.
self assert: Metaclass superclass == ClassDescription.
self assert: ClassDescription superclass == Behavior.
self assert: Behavior superclass = Object.
self assert: Class class class == Metaclass.
self assert: Metaclass class class == Metaclass.
self assert: ClassDescription class class == Metaclass.
self assert: Behavior class class == Metaclass.
!
----- Method: BasicBehaviorClassMetaclassTest>>testClassDescriptionAllSubInstances (in category 'testing') -----
testClassDescriptionAllSubInstances
"self run: #testClassDescriptionAllSubInstances"
| cdNo clsNo metaclsNo |
cdNo := ClassDescription allSubInstances size.
clsNo := Class allSubInstances size .
metaclsNo := Metaclass allSubInstances size.
self assert: cdNo = (clsNo + metaclsNo).
!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclass (in category 'testing') -----
testMetaclass
"self run: #testMetaclass"
self assert: OrderedCollection class class == Metaclass.
self assert: Dictionary class class == Metaclass.
self assert: Object class class == Metaclass.
!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassName (in category 'testing') -----
testMetaclassName
"self run: #testMetaclassName"
self assert: Dictionary class name = 'Dictionary class'.
self assert: OrderedCollection class name = 'OrderedCollection class'.
!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassNumberOfInstances (in category 'testing') -----
testMetaclassNumberOfInstances
"self run: #testMetaclassNumberOfInstances"
self assert: Dictionary class allInstances size = 1.
self assert: OrderedCollection class allInstances size = 1.!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassPointOfCircularity (in category 'testing') -----
testMetaclassPointOfCircularity
"self run: #testMetaclassPointOfCircularity"
self assert: Metaclass class instanceCount = 1.
self assert: Metaclass class someInstance == Metaclass.
!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclass (in category 'testing') -----
testMetaclassSuperclass
"self run: #testMetaclassSuperclass"
self assert: Dictionary class superclass == Set class.
self assert: OrderedCollection class superclass == SequenceableCollection class.
!
----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclassHierarchy (in category 'testing') -----
testMetaclassSuperclassHierarchy
"self run: #testMetaclassSuperclassHierarchy"
| s |
self assert: SequenceableCollection class instanceCount = 1.
self assert: Collection class instanceCount = 1.
self assert: Object class instanceCount = 1.
self assert: ProtoObject class instanceCount = 1.
s := OrderedCollection new.
s add: SequenceableCollection class.
s add: Collection class.
s add: Object class.
s add: ProtoObject class.
s add: Class.
s add: ClassDescription.
s add: Behavior.
s add: Object.
s add: ProtoObject.
self assert: OrderedCollection class allSuperclasses = s.
!
----- Method: BasicBehaviorClassMetaclassTest>>testObjectAllSubclasses (in category 'testing') -----
testObjectAllSubclasses
"self run: #testObjectAllSubclasses"
| n2 |
n2 := Object allSubclasses size.
self assert: n2 = (Object allSubclasses
select: [:cls | cls class class == Metaclass
or: [cls class == Metaclass]]) size!
----- Method: BasicBehaviorClassMetaclassTest>>testSuperclass (in category 'testing') -----
testSuperclass
"self run: #testSuperclass"
| s |
self assert: Dictionary superclass == Set.
self assert: OrderedCollection superclass == SequenceableCollection.
s := OrderedCollection new.
s add: SequenceableCollection.
s add: Collection.
s add: Object.
s add: ProtoObject.
self assert: OrderedCollection allSuperclasses = s.
!
TestCase subclass: #BehaviorTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: BehaviorTest>>testBehaviorSubclasses (in category 'tests') -----
testBehaviorSubclasses
"self run: #testBehaviorSubclasses"
| b b2 |
b := Behavior new.
b superclass: OrderedCollection.
b methodDictionary: MethodDictionary new.
self shouldnt: [b subclasses ] raise: Error.
self shouldnt: [b withAllSubclasses] raise: Error.
self shouldnt: [b allSubclasses] raise: Error.
b2 := Behavior new.
b2 superclass: b.
b2 methodDictionary: MethodDictionary new.
self assert: (b subclasses includes: b2).
self assert: (b withAllSubclasses includes: b).!
----- Method: BehaviorTest>>testBehaviornewnewShouldNotCrash (in category 'tests') -----
testBehaviornewnewShouldNotCrash
Behavior new new.
"still not working correctly but at least does not crash the image"
!
----- Method: BehaviorTest>>testBinding (in category 'tests') -----
testBinding
self assert: Object binding value = Object.
self assert: Object binding key = #Object.
self assert: Object class binding value = Object class.
"returns nil for Metaclasses... like Encoder>>#associationFor:"
self assert: Object class binding key isNil.!
----- Method: BehaviorTest>>testChange (in category 'tests') -----
testChange
"self debug: #testChange"
| behavior model |
behavior := Behavior new.
behavior superclass: Model.
behavior setFormat: Model format.
model := Model new.
model primitiveChangeClassTo: behavior new.
behavior compile: 'thisIsATest ^ 2'.
self assert: model thisIsATest = 2.
self should: [Model new thisIsATest] raise: MessageNotUnderstood.
!
TestCase subclass: #BlockContextTest
instanceVariableNames: 'aBlockContext contextOfaBlockContext'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!BlockContextTest commentStamp: 'jrp 10/17/2004 12:22' prior: 0!
I am an SUnit Test of BlockContext and its supertype ContextPart. See also MethodContextTest.
My fixtures are:
aBlockContext - just some trivial block, i.e., [100 at 100 corner: 200 at 200].
NOTES ABOUT AUTOMATING USER INPUTS
When executing non-interactive programs you will inevitably run into programs (like SqueakMap or Monticello installation packages -- and other programs, to be fair) that require user input during their execution and these sort of problems shoot the whole non-interactiveness of your enclosing program.
BlockContext helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept PopUpMenu and FillInTheBlankMorph requests for user interaction. Of course, PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be circumvented and the provided answer of the enclosing block will be used. The basic syntax looks like:
[self confirm: 'Install spyware?'] valueSupplyingAnswer: #('Install spyware?' false)
There a few variants on this theme making it easy to provide a literal list of answers for the block so that you can handle a bunch of questions in a block with appropriate answers.
Additionally, it is possible to suppress Object>>inform: modal dialog boxes as these get in the way of automating anything. After applying this changeset you should be able to tryout the following code snippets to see the variants on this theme that are available.
Examples:
So you don't need any introduction here -- this one works like usual.
[self inform: 'hello'. #done] value.
Now let's suppress all inform: messages.
[self inform: 'hello'; inform: 'there'. #done] valueSuppressingAllMessages.
Here we can just suppress a single inform: message.
[self inform: 'hi'; inform: 'there'. #done] valueSuppressingMessages: #('there')
Here you see how you can suppress a list of messages.
[self inform: 'hi'; inform: 'there'; inform: 'bill'. #done] valueSuppressingMessages: #('hi' 'there')
Enough about inform:, let's look at confirm:. As you see this one works as expected.
[self confirm: 'You like Squeak?'] value
Let's supply answers to one of the questions -- check out the return value.
[{self confirm: 'You like Smalltalk?'. self confirm: 'You like Squeak?'}]
valueSupplyingAnswer: #('You like Smalltalk?' true)
Here we supply answers using only substrings of the questions (for simplicity).
[{self confirm: 'You like Squeak?'. self confirm: 'You like MVC?'}]
valueSupplyingAnswers: #( ('Squeak' true) ('MVC' false) )
This time let's answer all questions exactly the same way.
[{self confirm: 'You like Squeak?'. self confirm: 'You like Morphic?'}]
valueSupplyingAnswer: true
And, of course, we can answer FillInTheBlank questions in the same manner.
[FillInTheBlank request: 'What day is it?']
valueSupplyingAnswer: 'the first day of the rest of your life'
We can also return whatever the initialAnswer of the FillInTheBlank was by using the #default answer.
[FillInTheBlank request: 'What day is it?' initialAnswer: DateAndTime now dayOfWeekName]
valueSupplyingAnswer: #default
Finally, you can also do regex matches on any of the question text (or inform text) (should you have VB-Regex enhancements in your image).
[FillInTheBlank request: 'What day is it?']
valueSupplyingAnswers: { {'What day.*\?'. DateAndTime now dayOfWeekName} }!
----- Method: BlockContextTest>>setUp (in category 'setup') -----
setUp
super setUp.
aBlockContext := [100 at 100 corner: 200 at 200].
contextOfaBlockContext := thisContext.!
----- Method: BlockContextTest>>testBlockIsBottomContext (in category 'tests') -----
testBlockIsBottomContext
self should: [aBlockContext client ] raise: Error. "block's sender is nil, a block has no client"
self assert: aBlockContext bottomContext = aBlockContext.
self assert: aBlockContext secondFromBottom isNil.!
----- Method: BlockContextTest>>testCopyStack (in category 'tests') -----
testCopyStack
self assert: aBlockContext copyStack printString = aBlockContext printString.!
----- Method: BlockContextTest>>testDecompile (in category 'tests - printing') -----
testDecompile
self assert: ([3 + 4] decompile printString = '{[3 + 4]}').!
----- Method: BlockContextTest>>testFindContextSuchThat (in category 'tests') -----
testFindContextSuchThat
self assert: (aBlockContext findContextSuchThat: [:each| true]) printString = aBlockContext printString.
self assert: (aBlockContext hasContext: aBlockContext). !
----- Method: BlockContextTest>>testNew (in category 'tests') -----
testNew
self should: [ContextPart new: 5] raise: Error.
[ContextPart new: 5]
ifError: [:error :receiver | error = 'Error: Contexts must only be created with newForMethod:'].
[ContextPart new]
ifError: [:error :receiver | error = 'Error: Contexts must only be created with newForMethod:'].
[ContextPart basicNew]
ifError: [:error :receiver | error = 'Error: Contexts must only be created with newForMethod:'].
!
----- Method: BlockContextTest>>testNoArguments (in category 'tests') -----
testNoArguments
[10
timesRepeat: [:arg | 1 + 2]]
ifError: [:err :rcvr | self deny: err = 'This block requires 1 arguments.'].
[10
timesRepeat: [:arg1 :arg2 | 1 + 2]]
ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.'] !
----- Method: BlockContextTest>>testOneArgument (in category 'tests') -----
testOneArgument
| c |
c := OrderedCollection new.
c add: 'hello'.
[c
do: [1 + 2]]
ifError: [:err :rcvr | self deny: err = 'This block requires 0 arguments.'].
[c
do: [:arg1 :arg2 | 1 + 2]]
ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.'] !
----- Method: BlockContextTest>>testRunSimulated (in category 'tests') -----
testRunSimulated
self assert: (ContextPart runSimulated: aBlockContext) class = Rectangle.!
----- Method: BlockContextTest>>testSetUp (in category 'tests') -----
testSetUp
"Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
self deny: aBlockContext isBlockClosure.
self deny: aBlockContext isMethodContext.
self deny: aBlockContext isPseudoContext.
self deny: aBlockContext isDead.
self assert: aBlockContext home = contextOfaBlockContext.
self assert: aBlockContext blockHome = contextOfaBlockContext.
self assert: aBlockContext receiver = self.
self assert: (aBlockContext method isKindOf: CompiledMethod).
self assert: aBlockContext methodNode selector = 'setUp'.
self assert: (aBlockContext methodNodeFormattedAndDecorated: true) selector = 'setUp'.!
----- Method: BlockContextTest>>testSupplyAnswerOfFillInTheBlank (in category 'testing') -----
testSupplyAnswerOfFillInTheBlank
self should: ['blue' = ([UIManager default request: 'Your favorite color?']
valueSupplyingAnswer: #('Your favorite color?' 'blue'))]!
----- Method: BlockContextTest>>testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer (in category 'testing') -----
testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer
self should: ['red' = ([UIManager default request: 'Your favorite color?' initialAnswer: 'red']
valueSupplyingAnswer: #('Your favorite color?' #default))]!
----- Method: BlockContextTest>>testSupplyAnswerThroughNestedBlocks (in category 'tests') -----
testSupplyAnswerThroughNestedBlocks
self should: [true = ([[self confirm: 'You like Smalltalk?']
valueSupplyingAnswer: #('Blub' false)] valueSupplyingAnswer: #('Smalltalk' true))]!
----- Method: BlockContextTest>>testSupplyAnswerUsingOnlySubstringOfQuestion (in category 'tests') -----
testSupplyAnswerUsingOnlySubstringOfQuestion
self should: [false = ([self confirm: 'You like Smalltalk?']
valueSupplyingAnswer: #('like' false))]!
----- Method: BlockContextTest>>testSupplyAnswerUsingRegexMatchOfQuestion (in category 'tests') -----
testSupplyAnswerUsingRegexMatchOfQuestion
(String includesSelector: #matchesRegex:) ifFalse: [^ self].
self should: [true = ([self confirm: 'You like Smalltalk?']
valueSupplyingAnswer: #('.*Smalltalk\?' true))]!
----- Method: BlockContextTest>>testSupplyAnswerUsingTraditionalMatchOfQuestion (in category 'tests') -----
testSupplyAnswerUsingTraditionalMatchOfQuestion
self should: [true = ([self confirm: 'You like Smalltalk?']
valueSupplyingAnswer: #('*Smalltalk#' true))]!
----- Method: BlockContextTest>>testSupplySameAnswerToAllQuestions (in category 'tests') -----
testSupplySameAnswerToAllQuestions
self should: [true = ([self confirm: 'You like Smalltalk?'] valueSupplyingAnswer: true)].
self should: [#(true true) = ([{self confirm: 'One'. self confirm: 'Two'}] valueSupplyingAnswer: true)].!
----- Method: BlockContextTest>>testSupplySeveralAnswersToSeveralQuestions (in category 'tests') -----
testSupplySeveralAnswersToSeveralQuestions
self should: [#(false true) = ([{self confirm: 'One'. self confirm: 'Two'}]
valueSupplyingAnswers: #( ('One' false) ('Two' true) ))].
self should: [#(true false) = ([{self confirm: 'One'. self confirm: 'Two'}]
valueSupplyingAnswers: #( ('One' true) ('Two' false) ))]!
----- Method: BlockContextTest>>testSupplySpecificAnswerToQuestion (in category 'tests') -----
testSupplySpecificAnswerToQuestion
self should: [false = ([self confirm: 'You like Smalltalk?']
valueSupplyingAnswer: #('You like Smalltalk?' false))]!
----- Method: BlockContextTest>>testSuppressInform (in category 'tests') -----
testSuppressInform
self should: [[nil inform: 'Should not see this message or this test failed!!'] valueSuppressingAllMessages isNil]!
----- Method: BlockContextTest>>testSuppressInformUsingStringMatchOptions (in category 'tests') -----
testSuppressInformUsingStringMatchOptions
self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('Should not see this message or this test failed!!')) isNil].
self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('not see this message')) isNil].
self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('*message*failed#')) isNil].
!
----- Method: BlockContextTest>>testTallyInstructions (in category 'tests') -----
testTallyInstructions
self assert: (ContextPart tallyInstructions: aBlockContext) size = 15.!
----- Method: BlockContextTest>>testTallyMethods (in category 'tests') -----
testTallyMethods
self assert: (ContextPart tallyMethods: aBlockContext) size = 3.!
----- Method: BlockContextTest>>testTempNamed (in category 'tests') -----
testTempNamed
| block |
block := [ | oneTemp | oneTemp := 1. oneTemp].
self assert: block value = 1.
self assert: (block tempNamed: 'oneTemp') = 1.
!
----- Method: BlockContextTest>>testTempNamedPut (in category 'tests') -----
testTempNamedPut
| block |
block := [ | oneTemp | oneTemp := 1. oneTemp].
self assert: block value = 1.
self assert: (block tempNamed: 'oneTemp') = 1.
block tempNamed: 'oneTemp' put: 2.
self assert: (block tempNamed: 'oneTemp') = 2.
!
----- Method: BlockContextTest>>testTrace (in category 'tests') -----
testTrace
self assert: (ContextPart trace: aBlockContext) class = Rectangle.!
----- Method: BlockContextTest>>testValueWithArguments (in category 'tests - evaluating') -----
testValueWithArguments
self
should: [aBlockContext
valueWithArguments: #(1 )]
raise: Error.
self
shouldnt: [aBlockContext
valueWithArguments: #()]
raise: Error.
[aBlockContext
valueWithArguments: #(1 )]
ifError: [:err :rcvr | self assert: err = 'Error: This block accepts 0 arguments, but was called with 1.'].
[[:i | 3 + 4]
valueWithArguments: #(1 2)]
ifError: [:err :rcvr | self assert: err = 'Error: This block accepts 1 argument, but was called with 2.']!
----- Method: BlockContextTest>>testValueWithExitBreak (in category 'tests - evaluating') -----
testValueWithExitBreak
| val |
[ :break |
1 to: 10 do: [ :i |
val := i.
i = 4 ifTrue: [break value].
]
] valueWithExit.
self assert: val = 4.!
----- Method: BlockContextTest>>testValueWithExitContinue (in category 'tests - evaluating') -----
testValueWithExitContinue
| val last |
val := 0.
1 to: 10 do: [ :i |
[ :continue |
i = 4 ifTrue: [continue value].
val := val + 1.
last := i
] valueWithExit.
].
self assert: val = 9.
self assert: last = 10. !
----- Method: BlockContextTest>>testValueWithPossibleArgs (in category 'tests - evaluating') -----
testValueWithPossibleArgs
| block blockWithArg blockWith2Arg |
block := [1].
blockWithArg := [:arg | arg].
blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
self assert: (block valueWithPossibleArgs: #()) = 1.
self assert: (block valueWithPossibleArgs: #(1)) = 1.
self assert: (blockWithArg valueWithPossibleArgs: #()) = nil.
self assert: (blockWithArg valueWithPossibleArgs: #(1)) = 1.
self assert: (blockWithArg valueWithPossibleArgs: #(1 2)) = 1.
self assert: (blockWith2Arg valueWithPossibleArgs: #()) = {nil .nil}.
self assert: (blockWith2Arg valueWithPossibleArgs: #(1)) = {1 . nil}.
self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2)) = #(1 2).
self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2 3)) = #(1 2).
!
----- Method: BlockContextTest>>testValueWithPossibleArgument (in category 'tests - evaluating') -----
testValueWithPossibleArgument
| block blockWithArg blockWith2Arg |
block := [1].
blockWithArg := [:arg | arg].
blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
self assert: (block valueWithPossibleArgument: 1) = 1.
self assert: (blockWithArg valueWithPossibleArgument: 1) = 1.
self assert: (blockWith2Arg valueWithPossibleArgument: 1) = {1 . nil}.
!
TestCase subclass: #ClassBuilderChangeClassTypeTest
instanceVariableNames: 'baseClass subClass'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: ClassBuilderChangeClassTypeTest>>baseClassName (in category 'utilities') -----
baseClassName
^'TestClassForClassChangeTest'!
----- Method: ClassBuilderChangeClassTypeTest>>cleanup (in category 'utilities') -----
cleanup
baseClass ifNotNil:[baseClass removeFromSystem].!
TestCase subclass: #ClassBuilderFormatTests
instanceVariableNames: 'baseClass subClass'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: ClassBuilderFormatTests>>baseClassName (in category 'utilities') -----
baseClassName
^#DummyClassBuilderFormatTestSuperClass!
----- Method: ClassBuilderFormatTests>>cleanup (in category 'utilities') -----
cleanup
subClass ifNotNil:[subClass removeFromSystem].
baseClass ifNotNil:[baseClass removeFromSystem].!
----- Method: ClassBuilderFormatTests>>makeByteVariableSubclassOf: (in category 'utilities') -----
makeByteVariableSubclassOf: aClass
subClass := aClass variableByteSubclass: self subClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'!
----- Method: ClassBuilderFormatTests>>makeIVarsSubclassOf: (in category 'utilities') -----
makeIVarsSubclassOf: aClass
subClass := aClass subclass: self subClassName
instanceVariableNames: 'var3 var4'
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'!
----- Method: ClassBuilderFormatTests>>makeNormalSubclassOf: (in category 'utilities') -----
makeNormalSubclassOf: aClass
subClass := aClass subclass: self subClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'!
----- Method: ClassBuilderFormatTests>>makeVariableSubclassOf: (in category 'utilities') -----
makeVariableSubclassOf: aClass
subClass := aClass variableSubclass: self subClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.!
----- Method: ClassBuilderFormatTests>>makeWeakSubclassOf: (in category 'utilities') -----
makeWeakSubclassOf: aClass
subClass := aClass weakSubclass: self subClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'!
----- Method: ClassBuilderFormatTests>>makeWordVariableSubclassOf: (in category 'utilities') -----
makeWordVariableSubclassOf: aClass
subClass := aClass variableWordSubclass: self subClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'!
----- Method: ClassBuilderFormatTests>>subClassName (in category 'utilities') -----
subClassName
^#DummyClassBuilderFormatTestSubClass!
----- Method: ClassBuilderFormatTests>>testByteVariableSubclass (in category 'testing') -----
testByteVariableSubclass
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object variableByteSubclass: self baseClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self assert: (subClass isBytes).
subClass removeFromSystem.
"pointer classes"
self should:[self makeIVarsSubclassOf: baseClass] raise: Error.
self should:[self makeVariableSubclassOf: baseClass] raise: Error.
self should:[self makeWeakSubclassOf: baseClass] raise: Error.
"bit classes"
self shouldnt:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self assert: (subClass isBytes).
subClass removeFromSystem.
self should:[self makeWordVariableSubclassOf: baseClass] raise: Error.
] ensure:[self cleanup].!
----- Method: ClassBuilderFormatTests>>testSubclass (in category 'testing') -----
testSubclass
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object subclass: self baseClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self deny: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"pointer classes"
self shouldnt:[self makeIVarsSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self deny: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeVariableSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert:(subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeWeakSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert:(subClass isVariable).
self assert:(subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"bit classes"
self shouldnt:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self assert: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeWordVariableSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
] ensure:[self cleanup].!
----- Method: ClassBuilderFormatTests>>testSubclassWithInstanceVariables (in category 'testing') -----
testSubclassWithInstanceVariables
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object subclass: self baseClassName
instanceVariableNames: 'var1 var2'
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self deny: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"pointer classes"
self shouldnt:[self makeIVarsSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self deny: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeVariableSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeWeakSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self assert: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"bit classes"
self should:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self should:[self makeWordVariableSubclassOf: baseClass] raise: Error.
] ensure:[self cleanup].!
----- Method: ClassBuilderFormatTests>>testVariableSubclass (in category 'testing') -----
testVariableSubclass
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object variableSubclass: self baseClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
"pointer classes"
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeIVarsSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeVariableSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeWeakSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self assert: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"bit classes"
self should:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self should:[self makeWordVariableSubclassOf: baseClass] raise: Error.
] ensure:[self cleanup].!
----- Method: ClassBuilderFormatTests>>testWeakSubclass (in category 'testing') -----
testWeakSubclass
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object weakSubclass: self baseClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
"pointer classes"
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self assert: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeIVarsSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self assert: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeVariableSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
self shouldnt:[self makeWeakSubclassOf: baseClass] raise: Error.
self assert: (subClass isPointers).
self assert: (subClass isVariable).
self assert: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"bit classes"
self should:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self should:[self makeWordVariableSubclassOf: baseClass] raise: Error.
] ensure:[self cleanup].!
----- Method: ClassBuilderFormatTests>>testWordVariableSubclass (in category 'testing') -----
testWordVariableSubclass
"Ensure that the invariants for superclass/subclass format are preserved"
baseClass := Object variableWordSubclass: self baseClassName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Tests-ClassBuilder'.
[
self shouldnt:[self makeNormalSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
"pointer classes"
self should:[self makeIVarsSubclassOf: baseClass] raise: Error.
self should:[self makeVariableSubclassOf: baseClass] raise: Error.
self should:[self makeWeakSubclassOf: baseClass] raise: Error.
"bit classes"
self should:[self makeByteVariableSubclassOf: baseClass] raise: Error.
self shouldnt:[self makeWordVariableSubclassOf: baseClass] raise: Error.
self deny: (subClass isPointers).
self assert: (subClass isVariable).
self deny: (subClass isWeak).
self deny: (subClass isBytes).
subClass removeFromSystem.
] ensure:[self cleanup].!
TestCase subclass: #ClassTest
instanceVariableNames: 'className renamedName'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: ClassTest>>deleteClass (in category 'setup') -----
deleteClass
| cl |
cl := Smalltalk at: className ifAbsent: [^self].
cl removeFromChanges; removeFromSystemUnlogged
!
----- Method: ClassTest>>deleteRenamedClass (in category 'setup') -----
deleteRenamedClass
| cl |
cl := Smalltalk at: renamedName ifAbsent: [^self].
cl removeFromChanges; removeFromSystemUnlogged
!
----- Method: ClassTest>>setUp (in category 'setup') -----
setUp
className := #TUTU.
renamedName := #RenamedTUTU.
self deleteClass.
self deleteRenamedClass.
Object subclass: className
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: ClassTest>>tearDown (in category 'setup') -----
tearDown
self deleteClass.
self deleteRenamedClass!
----- Method: ClassTest>>testAddInstVarName (in category 'testing') -----
testAddInstVarName
"self run: #testAddInstVarName"
| tutu |
tutu := Smalltalk at: #TUTU.
tutu addInstVarName: 'x'.
self assert: (tutu instVarNames = #('x')).
tutu addInstVarName: 'y'.
self assert: (tutu instVarNames = #('x' 'y'))
!
----- Method: ClassTest>>testCompileAll (in category 'testing - compiling') -----
testCompileAll
self shouldnt: [ClassTest compileAll] raise: Error.!
----- Method: ClassTest>>testHaSharedPools (in category 'testing - access') -----
testHaSharedPools
"self run: #testHaSharedPools"
self deny: Point hasSharedPools.
self assert: Date hasSharedPools!
----- Method: ClassTest>>testRenaming (in category 'testing') -----
testRenaming
"self debug: #testRenaming"
"self run: #testRenaming"
| 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).
!
TestCase subclass: #ComplexTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: ComplexTest>>testAbs (in category 'tests') -----
testAbs
"self run: #testAbs"
"self debug: #testAbs"
| c |
c := (6 - 6 i).
self assert: c abs = 72 sqrt.
!
----- Method: ComplexTest>>testAdding (in category 'tests') -----
testAdding
"self run: #testAdding"
| c |
c := (5 - 6 i) + (-5 + 8 i). "Complex with Complex"
self assert: (c = (0 + 2 i)).!
----- Method: ComplexTest>>testArg (in category 'tests') -----
testArg
"self run: #testArg"
"self debug: #testArg"
| c |
c := (0 + 5 i) .
self assert: c arg = (Float pi/ 2).
!
----- Method: ComplexTest>>testBug1 (in category 'testing - bugs') -----
testBug1
self assert: (0.5 * (2+0i) ln) exp = (0.5 * 2 ln) exp.!
----- Method: ComplexTest>>testComplexCollection (in category 'tests') -----
testComplexCollection
"self run: #testComplexCollection"
"self debug: #testComplexCollection"
| array array2 |
array := Array with: 1 + 2i with: 3 + 4i with: 5 + 6i.
array2 := 2 * array.
array with: array2 do: [:one :two | self assert: (2 * one) = two ] !
----- Method: ComplexTest>>testConversion (in category 'tests') -----
testConversion
"self run: #testConversion"
"self debug: #testConversion"
self assert: ((1 + 2i) + 1) = (2 + 2 i).
self assert: (1 + (1 + 2i)) = (2 + 2 i).
self assert: ((1 + 2i) + 1.0) = (2.0 + 2 i).
self assert: (1.0 + (1 + 2i)) = (2.0 + 2 i).
self assert: ((1 + 2i) + (2/3)) = ((5/3) + 2 i ).
self assert: ((2/3) + (1 + 2i)) = ((5/3) + 2 i )!
----- Method: ComplexTest>>testCreation (in category 'tests') -----
testCreation
"self run: #testCreation"
| c |
c := 5 i.
self assert: (c real = 0).
self assert: (c imaginary = 5).
c := 6 + 7 i.
self assert: (c real = 6).
self assert: ( c imaginary = 7).
c := 5.6 - 8 i.
self assert: (c real = 5.6).
self assert: (c imaginary = -8).
c := Complex real: 10 imaginary: 5.
self assert: (c real = 10).
self assert: (c imaginary = 5).
c := Complex abs: 5 arg: (Float pi/2).
self assert: (c real rounded = 0).
self assert: (c imaginary = 5).
!
----- Method: ComplexTest>>testDivision1 (in category 'tests') -----
testDivision1
"self run: #testDivision1"
"self debug: #testDivision1"
| c1 c2 quotient |
c1 := 2.0e252 + 3.0e70 i.
c2 := c1.
quotient := c1 / c2.
self deny: (quotient - 1) isZero.
"This test fails due to the wonders of floating point arithmetic.
Please have a look at Complex>>divideSecureBy: and #divideFastAndSecureBy:
how this can be avoided."
!
----- Method: ComplexTest>>testEquality (in category 'testing') -----
testEquality
"self run: #testEquality"
"self debug: #testEquality"
self assert: 0i = 0.
self assert: (2 - 5i) = ((1 -4 i) + (1 - 1i)).
self assert: 0i isZero.
self deny: (1 + 3 i) = 1.
self deny: (1 + 3 i) = (1 + 2i).
"Some more stuff"
self deny: (1 i) = nil.
self deny: nil = (1 i).
self deny: (1 i) = #(1 2 3).
self deny: #(1 2 3) = (1 i).
self deny: (1 i) = 0.
self deny: 0 = (1 i).
self assert: (1 + 0 i) = 1.
self assert: 1 = (1+ 0 i).
self assert: (1 + 0 i) = 1.0.
self assert: 1.0 = (1+ 0 i).
self assert: (1/2 + 0 i) = (1/2).
self assert: (1/2) = (1/2+ 0 i).!
----- Method: ComplexTest>>testLn (in category 'tests') -----
testLn
self assert: (Float e + 0 i) ln = Float e ln "See Bug 1815 on Mantis"!
----- Method: ComplexTest>>testNegated (in category 'tests') -----
testNegated
"self run: #testNegated"
"self debug: #testNegated"
| c |
c := (2 + 5 i) .
self assert: c negated = (-2 - 5i).
!
----- Method: ComplexTest>>testReciprocal (in category 'tests') -----
testReciprocal
"self run: #testReciprocal"
"self debug: #testReciprocal"
| c |
c := (2 + 5 i).
self assert: c reciprocal = ((2/29) - (5/29)i).
!
----- Method: ComplexTest>>testReciprocalError (in category 'tests') -----
testReciprocalError
"self run: #testReciprocalError"
"self debug: #testReciprocalError"
| c |
c := (0 i).
self should: [c reciprocal] raise: ZeroDivide
!
----- Method: ComplexTest>>testSecureDivision1 (in category 'tests') -----
testSecureDivision1
"self run: #testSecureDivision1"
"self debug: #testSecureDivision1"
| c1 c2 quotient |
c1 := 2.0e252 + 3.0e70 i.
c2 := c1.
quotient := c1 divideSecureBy: c2.
self assert: (quotient - 1) isZero.
!
----- Method: ComplexTest>>testSecureDivision2 (in category 'tests') -----
testSecureDivision2
"self run: #testSecureDivision2"
"self debug: #testSecureDivision2"
| c1 c2 quotient |
c1 := 2.0e252 + 3.0e70 i.
c2 := c1.
quotient := c1 divideFastAndSecureBy: c2.
self assert: (quotient - 1) isZero.
!
----- Method: ComplexTest>>testSquared (in category 'tests') -----
testSquared
"self run: #testSquared"
"self debug: #testSquared"
| c c2 |
c := (6 - 6 i).
c2 := (c squared).
self assert: c2 imaginary = -72.
self assert: c2 real = 0.!
TestCase subclass: #DateAndTimeEpochTest
instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!DateAndTimeEpochTest commentStamp: 'tlk 1/6/2004 18:27' prior: 0!
I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. The other Chronology sunit test cases are:
DateTestCase
DateAndTimeLeapTestCase,
DurationTestCase,
ScheduleTestCase
TimeStampTestCase
TimespanDoTestCase,
TimespanDoSpanAYearTestCase,
TimespanTestCase,
YearMonthWeekTestCase.
These tests attempt to exercise all public and private methods. Except, they do not explicitly depreciated methods. tlk
My fixtures are:
aDateAndTime = January 01, 1901 midnight (the start of the Squeak epoch) with localTimeZone = Grenwhich Meridian (local offset = 0 hours)
aDuration = 1 day, 2 hours, 3, minutes, 4 seconds and 5 nano seconds.
aTimeZone = 'Epoch Test Time Zone', 'ETZ' , offset: 12 hours, 15 minutes. !
----- Method: DateAndTimeEpochTest>>setUp (in category 'running') -----
setUp
localTimeZoneToRestore := DateAndTime localTimeZone.
aDateAndTime := DateAndTime localTimeZone: TimeZone default; epoch.
aTimeZone := TimeZone offset: (Duration minutes: 135) name: 'Epoch Test Time Zone' abbreviation: 'ETZ'.
aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 !
----- Method: DateAndTimeEpochTest>>tearDown (in category 'running') -----
tearDown
DateAndTime localTimeZone: localTimeZoneToRestore.
"wish I could remove the time zones I added earlier, tut there is no method for that"
!
----- Method: DateAndTimeEpochTest>>testAsDate (in category 'testing') -----
testAsDate
self assert: aDateAndTime asDate = 'January 1, 1901' asDate.
!
----- Method: DateAndTimeEpochTest>>testAsDateAndTime (in category 'testing') -----
testAsDateAndTime
self assert: aDateAndTime asDateAndTime = aDateAndTime
!
----- Method: DateAndTimeEpochTest>>testAsDuration (in category 'testing') -----
testAsDuration
self assert: aDateAndTime asDuration = 0 asDuration
!
----- Method: DateAndTimeEpochTest>>testAsLocal (in category 'testing') -----
testAsLocal
self assert: aDateAndTime asLocal = aDateAndTime.
self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset)
!
----- Method: DateAndTimeEpochTest>>testAsMonth (in category 'testing') -----
testAsMonth
self assert: aDateAndTime asMonth = (Month month: 'January' year: 1901).
!
----- Method: DateAndTimeEpochTest>>testAsNanoSeconds (in category 'testing') -----
testAsNanoSeconds
self assert: aDateAndTime asNanoSeconds = 0 asDuration asNanoSeconds
!
----- Method: DateAndTimeEpochTest>>testAsSeconds (in category 'testing') -----
testAsSeconds
self assert: aDateAndTime asSeconds = 0 asDuration asSeconds
!
----- Method: DateAndTimeEpochTest>>testAsTime (in category 'testing') -----
testAsTime
self assert: aDateAndTime asTime = Time midnight.
!
----- Method: DateAndTimeEpochTest>>testAsTimeStamp (in category 'testing') -----
testAsTimeStamp
self assert: aDateAndTime asTimeStamp = TimeStamp new.
!
----- Method: DateAndTimeEpochTest>>testAsUTC (in category 'testing') -----
testAsUTC
self assert: aDateAndTime asUTC = aDateAndTime
!
----- Method: DateAndTimeEpochTest>>testAsWeek (in category 'testing') -----
testAsWeek
self assert: aDateAndTime asWeek = (Week starting: '12-31-1900' asDate).
!
----- Method: DateAndTimeEpochTest>>testAsYear (in category 'testing') -----
testAsYear
self assert: aDateAndTime asYear = (Year starting: '01-01-1901' asDate).
!
----- Method: DateAndTimeEpochTest>>testCurrent (in category 'testing') -----
testCurrent
self deny: aDateAndTime = (DateAndTime current).
!
----- Method: DateAndTimeEpochTest>>testDateTime (in category 'testing') -----
testDateTime
self assert: aDateAndTime = (DateAndTime date: '01-01-1901' asDate time: '00:00:00' asTime)
!
----- Method: DateAndTimeEpochTest>>testDay (in category 'testing') -----
testDay
self assert: aDateAndTime day = DateAndTime new day
!
----- Method: DateAndTimeEpochTest>>testDayMonthYearDo (in category 'testing') -----
testDayMonthYearDo
|iterations|
iterations := 0.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | iterations := iterations + 1]) = 1.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 1901.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 1.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 1.
!
----- Method: DateAndTimeEpochTest>>testDayOfMonth (in category 'testing') -----
testDayOfMonth
self assert: aDateAndTime dayOfMonth = 1.
!
----- Method: DateAndTimeEpochTest>>testDayOfWeek (in category 'testing') -----
testDayOfWeek
self assert: aDateAndTime dayOfWeek = 3.
self assert: aDateAndTime dayOfWeekAbbreviation = 'Tue'.
self assert: aDateAndTime dayOfWeekName = 'Tuesday'.
!
----- Method: DateAndTimeEpochTest>>testDayOfYear (in category 'testing') -----
testDayOfYear
self assert: aDateAndTime dayOfYear = 1.
!
----- Method: DateAndTimeEpochTest>>testDaysInMonth (in category 'testing') -----
testDaysInMonth
self assert: aDateAndTime daysInMonth = 31.
!
----- Method: DateAndTimeEpochTest>>testDaysInYear (in category 'testing') -----
testDaysInYear
self assert: aDateAndTime daysInYear = 365.
!
----- Method: DateAndTimeEpochTest>>testDaysLeftInYear (in category 'testing') -----
testDaysLeftInYear
self assert: aDateAndTime daysLeftInYear = 364.
!
----- Method: DateAndTimeEpochTest>>testDuration (in category 'testing') -----
testDuration
self assert: aDateAndTime duration = 0 asDuration.
!
----- Method: DateAndTimeEpochTest>>testEpoch (in category 'testing') -----
testEpoch
self assert: aDateAndTime = '1901-01-01T00:00:00+00:00'.
!
----- Method: DateAndTimeEpochTest>>testFirstDayOfMonth (in category 'testing') -----
testFirstDayOfMonth
self assert: aDateAndTime firstDayOfMonth = 1
!
----- Method: DateAndTimeEpochTest>>testFromSeconds (in category 'testing') -----
testFromSeconds
self assert: aDateAndTime = (DateAndTime fromSeconds: 0).
!
----- Method: DateAndTimeEpochTest>>testFromString (in category 'testing') -----
testFromString
self assert: aDateAndTime = (DateAndTime fromString: ' 1901-01-01T00:00:00+00:00').
self assert: aDateAndTime = (DateAndTime fromString: ' 1901-01-01T00:00:00').
self assert: aDateAndTime = (DateAndTime fromString: ' 1901-01-01T00:00').
self assert: aDateAndTime = (DateAndTime fromString: ' 1901-01-01T00:00:00+00:00').
!
----- Method: DateAndTimeEpochTest>>testHash (in category 'testing') -----
testHash
self assert: aDateAndTime hash = DateAndTime new hash!
----- Method: DateAndTimeEpochTest>>testHour (in category 'testing') -----
testHour
self assert: aDateAndTime hour = aDateAndTime hour24.
self assert: aDateAndTime hour = 0.
self assert: aDateAndTime hour = aDateAndTime hours
!
----- Method: DateAndTimeEpochTest>>testHour12 (in category 'testing') -----
testHour12
self assert: aDateAndTime hour12 = DateAndTime new hour12.
self assert: aDateAndTime hour12 = 12
!
----- Method: DateAndTimeEpochTest>>testIsLeapYear (in category 'testing') -----
testIsLeapYear
self deny: aDateAndTime isLeapYear
!
----- Method: DateAndTimeEpochTest>>testJulianDayNumber (in category 'testing') -----
testJulianDayNumber
self assert: aDateAndTime = (DateAndTime julianDayNumber: 2415386).
self assert: aDateAndTime julianDayNumber = 2415386.!
----- Method: DateAndTimeEpochTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aDateAndTime < (aDateAndTime + '1:00:00:00').
self assert: aDateAndTime + -1 < aDateAndTime.
!
----- Method: DateAndTimeEpochTest>>testMeridianAbbreviation (in category 'testing') -----
testMeridianAbbreviation
self assert: aDateAndTime meridianAbbreviation = 'AM'.
!
----- Method: DateAndTimeEpochTest>>testMiddleOf (in category 'testing') -----
testMiddleOf
self assert: (aDateAndTime middleOf: '2:00:00:00' asDuration) =
(Timespan starting: '12-31-1900' asDate duration: 2 days).
!
----- Method: DateAndTimeEpochTest>>testMidnight (in category 'testing') -----
testMidnight
self assert: aDateAndTime midnight = aDateAndTime
!
----- Method: DateAndTimeEpochTest>>testMinus (in category 'testing') -----
testMinus
self assert: aDateAndTime - aDateAndTime = '0:00:00:00' asDuration.
self assert: aDateAndTime - '0:00:00:00' asDuration = aDateAndTime.
self assert: aDateAndTime - aDuration = (DateAndTime year: 1900 month: 12 day: 30 hour: 21 minute: 56 second: 55 nanoSecond: 999999995 offset: 0 hours ).
" I believe this Failure is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)" !
----- Method: DateAndTimeEpochTest>>testMinute (in category 'testing') -----
testMinute
self assert: aDateAndTime minute = 0
!
----- Method: DateAndTimeEpochTest>>testMinutes (in category 'testing') -----
testMinutes
self assert: aDateAndTime minutes = 0
!
----- Method: DateAndTimeEpochTest>>testMonth (in category 'testing') -----
testMonth
self assert: aDateAndTime month = 1.
self assert: aDateAndTime monthAbbreviation = 'Jan'.
self assert: aDateAndTime monthName = 'January'.
self assert: aDateAndTime monthIndex = 1.!
----- Method: DateAndTimeEpochTest>>testNanoSecond (in category 'testing') -----
testNanoSecond
self assert: aDateAndTime nanoSecond = 0
!
----- Method: DateAndTimeEpochTest>>testNew (in category 'testing') -----
testNew
self assert: aDateAndTime = (DateAndTime new).
!
----- Method: DateAndTimeEpochTest>>testNoon (in category 'testing') -----
testNoon
self assert: aDateAndTime noon = '1901-01-01T12:00:00+00:00'.
!
----- Method: DateAndTimeEpochTest>>testNow (in category 'testing') -----
testNow
self deny: aDateAndTime = (DateAndTime now).
!
----- Method: DateAndTimeEpochTest>>testOffset (in category 'testing') -----
testOffset
self assert: aDateAndTime offset = '0:00:00:00' asDuration.
self assert: (aDateAndTime offset: '0:12:00:00') = '1901-01-01T00:00:00+12:00'.
!
----- Method: DateAndTimeEpochTest>>testPlus (in category 'testing') -----
testPlus
self assert: aDateAndTime + '0:00:00:00' = aDateAndTime.
self assert: aDateAndTime + 0 = aDateAndTime.
self assert: aDateAndTime + aDuration = (DateAndTime year: 1901 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours )
" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"
!
----- Method: DateAndTimeEpochTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '1901-01-01T00:00:00+00:00' readStream.
rw := ReadWriteStream on: ''.
aDateAndTime printOn: rw.
self assert: rw contents = cs contents.
cs := 'a TimeZone(ETZ)' readStream.
rw := ReadWriteStream on: ''.
aTimeZone printOn: rw.
self assert: rw contents = cs contents!
----- Method: DateAndTimeEpochTest>>testSecond (in category 'testing') -----
testSecond
self assert: aDateAndTime second = 0
!
----- Method: DateAndTimeEpochTest>>testSeconds (in category 'testing') -----
testSeconds
self assert: aDateAndTime seconds = 0
!
----- Method: DateAndTimeEpochTest>>testTicks (in category 'testing') -----
testTicks
self assert: aDateAndTime ticks = (DateAndTime julianDayNumber: 2415386) ticks.
self assert: aDateAndTime ticks = #(2415386 0 0)!
----- Method: DateAndTimeEpochTest>>testTicksOffset (in category 'testing') -----
testTicksOffset
self assert: aDateAndTime = (aDateAndTime ticks: #(2415386 0 0) offset: DateAndTime localOffset).
!
----- Method: DateAndTimeEpochTest>>testTo (in category 'testing') -----
testTo
self assert: (aDateAndTime to: aDateAndTime) = (DateAndTime new to: DateAndTime new)
"MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "!
----- Method: DateAndTimeEpochTest>>testToBy (in category 'testing') -----
testToBy
self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days) =
(DateAndTime new to: DateAndTime new + 10 days by: 5 days )
"MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "!
----- Method: DateAndTimeEpochTest>>testToByDo (in category 'testing') -----
testToByDo
"self assert: (aDateAndTime to: aDateAndTime + 10 days by: 5 days do: []) = "
"MessageNotUnderstood: UndefinedObject>>starting:ending: where UndefinedObject is Timespan "!
----- Method: DateAndTimeEpochTest>>testToday (in category 'testing') -----
testToday
self deny: aDateAndTime = (DateAndTime today).
!
----- Method: DateAndTimeEpochTest>>testTommorrow (in category 'testing') -----
testTommorrow
self assert: (DateAndTime today + 24 hours) = (DateAndTime tomorrow).
self deny: aDateAndTime = (DateAndTime tomorrow).
"MessageNotUnderstood: Date class>>starting:"!
----- Method: DateAndTimeEpochTest>>testUtcOffset (in category 'testing') -----
testUtcOffset
self assert: (aDateAndTime utcOffset: '0:12:00:00') = '1901-01-01T12:00:00+12:00'.
!
----- Method: DateAndTimeEpochTest>>testYear (in category 'testing') -----
testYear
self assert: aDateAndTime year = 1901.
!
----- Method: DateAndTimeEpochTest>>testYearDay (in category 'testing') -----
testYearDay
self assert: aDateAndTime = (DateAndTime year: 1901 day: 1).
!
----- Method: DateAndTimeEpochTest>>testYearDayHourMinuteSecond (in category 'testing') -----
testYearDayHourMinuteSecond
self assert: aDateAndTime = (DateAndTime year: 1901 day: 1 hour: 0 minute: 0 second: 0).
!
----- Method: DateAndTimeEpochTest>>testYearMonthDay (in category 'testing') -----
testYearMonthDay
self assert: aDateAndTime = (DateAndTime year: 1901 month: 1 day: 1).
!
----- Method: DateAndTimeEpochTest>>testYearMonthDayHourMinuteSecond (in category 'testing') -----
testYearMonthDayHourMinuteSecond
self assert: aDateAndTime = (DateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0).
!
----- Method: DateAndTimeEpochTest>>testYearMonthDayHourMinuteSecondNanosSecondOffset (in category 'testing') -----
testYearMonthDayHourMinuteSecondNanosSecondOffset
self assert: aDateAndTime = (DateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset:0 hours ).
self assert: ((DateAndTime year: 1 month: 1 day: 1 hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: 0 hours ) +
(Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) ) =
(DateAndTime year: 1 month: 1 day: 2 hour: 2 minute: 3 second: 4 nanoSecond: 5 offset: 0 hours )
" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"" I believe this is a bug in the nanosecond part of (DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset:)"
!
----- Method: DateAndTimeEpochTest>>testYesterday (in category 'testing') -----
testYesterday
self deny: aDateAndTime = (DateAndTime yesterday).
!
----- Method: DateAndTimeEpochTest>>testtimeZone (in category 'testing') -----
testtimeZone
self assert: aDateAndTime timeZoneName = 'Universal Time'.
self assert: aDateAndTime timeZoneAbbreviation = 'UTC'
!
TestCase subclass: #DateAndTimeLeapTest
instanceVariableNames: 'aDateAndTime aDuration aTimeZone localTimeZoneToRestore'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!DateAndTimeLeapTest commentStamp: 'tlk 1/6/2004 17:54' prior: 0!
I represent one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. tlk.
My fixtures are:
aDateAndTime = February 29, 2004 1:33 PM with offset: 2 hours
aDuration = 15 days, 14 hours, 13 minutes, 12 seconds and 11 nano seconds.
aTimeZone = Grenwhich Meridian (local offset = 0 hours) !
----- Method: DateAndTimeLeapTest>>setUp (in category 'running') -----
setUp
localTimeZoneToRestore := DateAndTime localTimeZone.
DateAndTime localTimeZone: TimeZone default.
aDateAndTime := (DateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0 offset: 2 hours).
aTimeZone := TimeZone default.
aDuration := Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0
!
----- Method: DateAndTimeLeapTest>>tearDown (in category 'running') -----
tearDown
DateAndTime localTimeZone: localTimeZoneToRestore.
"wish I could remove the time zones I added earlier, tut there is no method for that"
!
----- Method: DateAndTimeLeapTest>>testAsDate (in category 'testing') -----
testAsDate
self assert: aDateAndTime asDate = 'February 29, 2004' asDate.
!
----- Method: DateAndTimeLeapTest>>testAsDuration (in category 'testing') -----
testAsDuration
self assert: aDateAndTime asDuration = aDuration
!
----- Method: DateAndTimeLeapTest>>testAsLocal (in category 'testing') -----
testAsLocal
self assert: aDateAndTime asLocal = aDateAndTime.
self assert: aDateAndTime asLocal = (aDateAndTime utcOffset: aDateAndTime class localOffset)
!
----- Method: DateAndTimeLeapTest>>testAsMonth (in category 'testing') -----
testAsMonth
self assert: aDateAndTime asMonth = (Month month: 'February' year: 2004).
!
----- Method: DateAndTimeLeapTest>>testAsNanoSeconds (in category 'testing') -----
testAsNanoSeconds
self assert: aDateAndTime asNanoSeconds = aDuration asNanoSeconds.
self assert: aDateAndTime asNanoSeconds = 48780000000000
!
----- Method: DateAndTimeLeapTest>>testAsSeconds (in category 'testing') -----
testAsSeconds
self assert: aDuration asSeconds = 48780.
self assert: aDateAndTime asSeconds = 3255507180
!
----- Method: DateAndTimeLeapTest>>testAsTime (in category 'testing') -----
testAsTime
self assert: aDateAndTime asTime = (Time hour: 13 minute: 33 second: 0)
!
----- Method: DateAndTimeLeapTest>>testAsTimeStamp (in category 'testing') -----
testAsTimeStamp
self assert: aDateAndTime asTimeStamp = ((TimeStamp readFrom: '2-29-2004 1:33 pm' readStream) offset: 2 hours).
!
----- Method: DateAndTimeLeapTest>>testAsUTC (in category 'testing') -----
testAsUTC
self assert: aDateAndTime asUTC = aDateAndTime
!
----- Method: DateAndTimeLeapTest>>testAsWeek (in category 'testing') -----
testAsWeek
self assert: aDateAndTime asWeek = (Week starting: '02-29-2004' asDate).
!
----- Method: DateAndTimeLeapTest>>testAsYear (in category 'testing') -----
testAsYear
self assert: aDateAndTime asYear = (Year starting: '02-29-2004' asDate).
self deny: aDateAndTime asYear = (Year starting: '01-01-2004' asDate)
!
----- Method: DateAndTimeLeapTest>>testDay (in category 'testing') -----
testDay
self assert: aDateAndTime day = 60.
self deny: aDateAndTime day = 29 !
----- Method: DateAndTimeLeapTest>>testDayMonthYearDo (in category 'testing') -----
testDayMonthYearDo
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachYear]) = 2004.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachMonth]) = 2.
self assert: (aDateAndTime dayMonthYearDo: [:eachDay :eachMonth :eachYear | eachDay]) = 29.
!
----- Method: DateAndTimeLeapTest>>testDayOfMonth (in category 'testing') -----
testDayOfMonth
self assert: aDateAndTime dayOfMonth = 29.
!
----- Method: DateAndTimeLeapTest>>testDayOfWeek (in category 'testing') -----
testDayOfWeek
self assert: aDateAndTime dayOfWeek = 1.
self assert: aDateAndTime dayOfWeekAbbreviation = 'Sun'.
self assert: aDateAndTime dayOfWeekName = 'Sunday'.
!
----- Method: DateAndTimeLeapTest>>testDayOfYear (in category 'testing') -----
testDayOfYear
self assert: aDateAndTime dayOfYear = 60.
!
----- Method: DateAndTimeLeapTest>>testDaysInMonth (in category 'testing') -----
testDaysInMonth
self assert: aDateAndTime daysInMonth = 29.
!
----- Method: DateAndTimeLeapTest>>testDaysInYear (in category 'testing') -----
testDaysInYear
self assert: aDateAndTime daysInYear = 366.
!
----- Method: DateAndTimeLeapTest>>testDaysLeftInYear (in category 'testing') -----
testDaysLeftInYear
self assert: aDateAndTime daysLeftInYear = 306.
!
----- Method: DateAndTimeLeapTest>>testFirstDayOfMonth (in category 'testing') -----
testFirstDayOfMonth
self deny: aDateAndTime firstDayOfMonth = 1.
self assert: aDateAndTime firstDayOfMonth = 32
!
----- Method: DateAndTimeLeapTest>>testFromString (in category 'testing') -----
testFromString
self assert: aDateAndTime = (DateAndTime fromString: ' 2004-02-29T13:33:00+02:00').
!
----- Method: DateAndTimeLeapTest>>testHour (in category 'testing') -----
testHour
self assert: aDateAndTime hour = aDateAndTime hour24.
self assert: aDateAndTime hour = 13.
self assert: aDateAndTime hour = aDateAndTime hours
!
----- Method: DateAndTimeLeapTest>>testHour12 (in category 'testing') -----
testHour12
self assert: aDateAndTime hour12 = 1.
!
----- Method: DateAndTimeLeapTest>>testIsLeapYear (in category 'testing') -----
testIsLeapYear
self assert: aDateAndTime isLeapYear
!
----- Method: DateAndTimeLeapTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aDateAndTime < (aDateAndTime + '1:00:00:00').
self assert: aDateAndTime + -1 < aDateAndTime.
!
----- Method: DateAndTimeLeapTest>>testMeridianAbbreviation (in category 'testing') -----
testMeridianAbbreviation
self assert: aDateAndTime meridianAbbreviation = 'PM'.
!
----- Method: DateAndTimeLeapTest>>testMiddleOf (in category 'testing') -----
testMiddleOf
self assert: (aDateAndTime middleOf: aDuration) =
(Timespan starting: (DateAndTime year: 2004 month: 2 day: 29 hour: 6 minute: 46 second: 30 offset: 2 hours)
duration: (Duration days: 0 hours: 13 minutes: 33 seconds: 0 nanoSeconds: 0 ))
!
----- Method: DateAndTimeLeapTest>>testMidnight (in category 'testing') -----
testMidnight
self assert: aDateAndTime midnight = '2004-02-29T00:00:00+00:00'.
self deny: aDateAndTime midnight = '2004-02-29T00:00:00+02:00'
!
----- Method: DateAndTimeLeapTest>>testMinute (in category 'testing') -----
testMinute
self assert: aDateAndTime minute = 33
!
----- Method: DateAndTimeLeapTest>>testMinutes (in category 'testing') -----
testMinutes
self assert: aDateAndTime minutes = 33
!
----- Method: DateAndTimeLeapTest>>testMonth (in category 'testing') -----
testMonth
self assert: aDateAndTime month = 2.
self assert: aDateAndTime monthAbbreviation = 'Feb'.
self assert: aDateAndTime monthName = 'February'.
self assert: aDateAndTime monthIndex = 2.!
----- Method: DateAndTimeLeapTest>>testNanoSecond (in category 'testing') -----
testNanoSecond
self assert: aDateAndTime nanoSecond = 0
!
----- Method: DateAndTimeLeapTest>>testNoon (in category 'testing') -----
testNoon
self assert: aDateAndTime noon = '2004-02-29T12:00:00+00:00'.
!
----- Method: DateAndTimeLeapTest>>testOffset (in category 'testing') -----
testOffset
self assert: aDateAndTime offset = '0:02:00:00' asDuration.
self assert: (aDateAndTime offset: '0:12:00:00') = '2004-02-29T13:33:00+12:00'.
!
----- Method: DateAndTimeLeapTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '2004-02-29T13:33:00+02:00' readStream.
rw := ReadWriteStream on: ''.
aDateAndTime printOn: rw.
self assert: rw contents = cs contents.
cs := 'a TimeZone(UTC)' readStream.
rw := ReadWriteStream on: ''.
aTimeZone printOn: rw.
self assert: rw contents = cs contents!
----- Method: DateAndTimeLeapTest>>testSecond (in category 'testing') -----
testSecond
self assert: aDateAndTime second = 0
!
----- Method: DateAndTimeLeapTest>>testSeconds (in category 'testing') -----
testSeconds
self assert: aDateAndTime seconds = 0
!
----- Method: DateAndTimeLeapTest>>testTicks (in category 'testing') -----
testTicks
self assert: aDateAndTime ticks = ((DateAndTime julianDayNumber: 2453065) + 48780 seconds) ticks.
self assert: aDateAndTime ticks = #(2453065 48780 0)!
----- Method: DateAndTimeLeapTest>>testTicksOffset (in category 'testing') -----
testTicksOffset
self assert: aDateAndTime = (aDateAndTime ticks: #(2453065 48780 0) offset: DateAndTime localOffset).
!
----- Method: DateAndTimeLeapTest>>testUtcOffset (in category 'testing') -----
testUtcOffset
self assert: (aDateAndTime utcOffset: '0:02:00:00') = '2004-02-29T13:33:00+02:00'.
!
----- Method: DateAndTimeLeapTest>>testYear (in category 'testing') -----
testYear
self assert: aDateAndTime year = 2004.
!
----- Method: DateAndTimeLeapTest>>testYearDayHourMinuteSecond (in category 'testing') -----
testYearDayHourMinuteSecond
self assert: aDateAndTime = ((DateAndTime year: 2004 day: 60 hour: 13 minute: 33 second: 0) offset: 2 hours).
!
----- Method: DateAndTimeLeapTest>>testYearMonthDayHourMinuteSecond (in category 'testing') -----
testYearMonthDayHourMinuteSecond
self assert: aDateAndTime = ((DateAndTime year: 2004 month: 2 day: 29 hour: 13 minute: 33 second: 0) offset: 2 hours).
!
----- Method: DateAndTimeLeapTest>>testtimeZone (in category 'testing') -----
testtimeZone
self assert: aDateAndTime timeZoneName = 'Universal Time'.
self assert: aDateAndTime timeZoneAbbreviation = 'UTC'
!
TestCase subclass: #DelayTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Processes'!
----- Method: DelayTest>>testBounds (in category 'testing') -----
testBounds
"self run: #testBounds"
self should: [Delay forMilliseconds: -1] raise: Error.
self should: [Delay forMilliseconds: SmallInteger maxVal // 2 + 1] raise: Error. "Not longer than a day"
self shouldnt: [Delay forMilliseconds: SmallInteger maxVal // 2] raise: Error.
self shouldnt: [(Delay forMilliseconds: Float pi) wait] raise: Error. "Wait 3ms"
!
----- Method: DelayTest>>testSemaphore (in category 'testing') -----
testSemaphore
"When we provide our own semaphore for a Delay, it should be used"
"See http://bugs.squeak.org/view.php?id=6834"
"self run: #testSemaphore"
| sem process |
sem := Semaphore new.
[
process := [Delay timeoutSemaphore: sem afterMSecs: 0. sem wait] newProcess.
process priority: Processor highIOPriority.
process resume.
self assert: process isTerminated.
] ensure: [sem signal]!
TestCase subclass: #IVsAndClassVarNamesConflictTest
instanceVariableNames: 'class className'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
----- Method: IVsAndClassVarNamesConflictTest>>setUp (in category 'setup') -----
setUp
super setUp.
className := #ClassForTestToBeDeleted.
class := Object subclass: className
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: self class category!
----- Method: IVsAndClassVarNamesConflictTest>>tearDown (in category 'setup') -----
tearDown
super tearDown.
class ifNil:[^self].
class isObsolete ifFalse: [
class removeFromChanges.
class removeFromSystemUnlogged].
ChangeSet current
removeClassChanges: className;
removeClassChanges: className, ' class'!
----- Method: IVsAndClassVarNamesConflictTest>>testClassWithInvalidClassVariablesShouldNotBeReferencedByItsSuperclass (in category 'tests') -----
testClassWithInvalidClassVariablesShouldNotBeReferencedByItsSuperclass
| initialSubclasses |
initialSubclasses := Object subclasses.
self should: [Object subclass: className
instanceVariableNames: 'a b c'
classVariableNames: 'a b c'
poolDictionaries: ''
category: self class category]
raise: Exception.
self assert: initialSubclasses = Object subclasses
!
----- Method: IVsAndClassVarNamesConflictTest>>testIvNamesAndClassVarNamesShouldBeDifferent (in category 'tests') -----
testIvNamesAndClassVarNamesShouldBeDifferent
self should: [Object subclass: className
instanceVariableNames: 'a b c'
classVariableNames: 'a b c'
poolDictionaries: ''
category: self class category]
raise: Exception.
self should: [Object subclass: className
instanceVariableNames: 'A B C'
classVariableNames: 'A B C'
poolDictionaries: ''
category: self class category]
raise: Exception.
!
TestCase subclass: #InstVarRefLocatorTest
instanceVariableNames: 'tt'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!InstVarRefLocatorTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class InstVarRefLocator. 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!
----- Method: InstVarRefLocatorTest>>example1 (in category 'examples') -----
example1
| ff |
(1 < 2) ifTrue: [tt ifNotNil: [ff := 'hallo']].
^ ff.!
----- Method: InstVarRefLocatorTest>>example2 (in category 'examples') -----
example2
| ff|
ff := 1.
(1 < 2) ifTrue: [ff ifNotNil: [ff := 'hallo']].
^ ff.!
----- Method: InstVarRefLocatorTest>>hasInstVarRef: (in category 'private') -----
hasInstVarRef: aMethod
"Answer whether the receiver references an instance variable."
| scanner end printer |
scanner := InstructionStream on: aMethod.
printer := InstVarRefLocator new.
end := scanner method endPC.
[scanner pc <= end] whileTrue: [
(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
].
^false!
----- Method: InstVarRefLocatorTest>>testExample1 (in category 'tests') -----
testExample1
| method |
method := self class compiledMethodAt: #example1.
self assert: (self hasInstVarRef: method).!
----- Method: InstVarRefLocatorTest>>testExample2 (in category 'tests') -----
testExample2
| method |
method := self class compiledMethodAt: #example2.
self deny: (self hasInstVarRef: method).!
----- Method: InstVarRefLocatorTest>>testInstructions (in category 'tests') -----
testInstructions
| scanner end printer |
Object methods do: [:method |
scanner := InstructionStream on: method.
printer := InstVarRefLocator new.
end := scanner method endPC.
[scanner pc <= end] whileTrue: [
self shouldnt: [printer interpretNextInstructionUsing: scanner] raise: Error.
].
].!
TestCase subclass: #InstructionClientTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!InstructionClientTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class InstructionClient. 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!
----- Method: InstructionClientTest>>testInstructions (in category 'tests') -----
testInstructions
"just interpret all of methods of Object"
| client scanner|
client := InstructionClient new.
Object methods do: [:method |
scanner := (InstructionStream on: method).
[scanner pc <= method endPC] whileTrue: [
self shouldnt: [scanner interpretNextInstructionFor: client] raise: Error.
].
].
!
TestCase subclass: #IntegerDigitLogicTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: IntegerDigitLogicTest>>testAndSingleBitWithMinusOne (in category 'tests') -----
testAndSingleBitWithMinusOne
"And a single bit with -1 and test for same value"
1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].!
----- Method: IntegerDigitLogicTest>>testMixedSignDigitLogic (in category 'tests') -----
testMixedSignDigitLogic
"Verify that mixed sign logic with large integers works."
self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE!
----- Method: IntegerDigitLogicTest>>testNBitAndNNegatedEqualsN (in category 'tests') -----
testNBitAndNNegatedEqualsN
"Verify that (n bitAnd: n negated) = n for single bits"
| n |
1 to: 100 do: [:i | n := 1 bitShift: i.
self assert: (n bitAnd: n negated) = n]!
----- Method: IntegerDigitLogicTest>>testNNegatedEqualsNComplementedPlusOne (in category 'tests') -----
testNNegatedEqualsNComplementedPlusOne
"Verify that n negated = (n complemented + 1) for single bits"
| n |
1 to: 100 do: [:i | n := 1 bitShift: i.
self assert: n negated = ((n bitXor: -1) + 1)]!
----- Method: IntegerDigitLogicTest>>testShiftMinusOne1LeftThenRight (in category 'tests') -----
testShiftMinusOne1LeftThenRight
"Shift -1 left then right and test for 1"
1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1].
!
----- Method: IntegerDigitLogicTest>>testShiftOneLeftThenRight (in category 'tests') -----
testShiftOneLeftThenRight
"Shift 1 bit left then right and test for 1"
1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1].
!
TestCase subclass: #IntegerTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: IntegerTest>>testBadBase (in category 'tests - printing') -----
testBadBase
"This used to get into an endless loop.
See Pharo #114"
self should: [2 printStringBase: 1] raise: Error.!
----- Method: IntegerTest>>testBenchFib (in category 'tests - benchmarks') -----
testBenchFib
self assert: (0 benchFib = 1).
self assert: (1 benchFib = 1).
self assert: (2 benchFib = 3).
!
----- Method: IntegerTest>>testBitLogic (in category 'tests - bitLogic') -----
testBitLogic
"This little suite of tests is designed to verify correct operation of most
of Squeak's bit manipulation code, including two's complement
representation of negative values. It was written in a hurry and
is probably lacking several important checks."
"Shift 1 bit left then right and test for 1"
"self run: #testBitLogic"
| n |
1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1].
"Shift -1 left then right and test for 1"
1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1].
"And a single bit with -1 and test for same value"
1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].
"Verify that (n bitAnd: n negated) = n for single bits"
1 to: 100 do: [:i | n := 1 bitShift: i. self assert: (n bitAnd: n negated) = n].
"Verify that n negated = (n complemented + 1) for single bits"
1 to: 100 do: [:i |
n := 1 bitShift: i.
self assert: n negated = ((n bitXor: -1) + 1)].
"Verify that (n + n complemented) = -1 for single bits"
1 to: 100 do: [:i |
n := 1 bitShift: i.
self assert: (n + (n bitXor: -1)) = -1].
"Verify that n negated = (n complemented +1) for single bits"
1 to: 100 do: [:i |
n := 1 bitShift: i.
self assert: n negated = ((n bitXor: -1) + 1)].
self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE.!
----- Method: IntegerTest>>testCreationFromBytes1 (in category 'tests - instance creation') -----
testCreationFromBytes1
"self run: #testCreationFromBytes1"
"it is illegal for a LargeInteger to be less than SmallInteger maxVal."
"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs SmallInteger maxVal as an instance of SmallInteger. "
| maxSmallInt hexString byte1 byte2 byte3 byte4
builtInteger |
maxSmallInt := SmallInteger maxVal.
hexString := maxSmallInt printStringHex.
self assert: hexString size = 8.
byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
self assert: builtInteger = maxSmallInt.
self assert: builtInteger class = SmallInteger
!
----- Method: IntegerTest>>testCreationFromBytes2 (in category 'tests - instance creation') -----
testCreationFromBytes2
"self run: #testCreationFromBytes2"
"it is illegal for a LargeInteger to be less than SmallInteger maxVal."
"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs (SmallInteger maxVal + 1) as an instance of LargePositiveInteger. "
| maxSmallInt hexString byte1 byte2 byte3 byte4 builtInteger |
maxSmallInt := SmallInteger maxVal.
hexString := (maxSmallInt + 1) printStringHex.
self assert: hexString size = 8.
byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
self assert: builtInteger = (maxSmallInt + 1).
self deny: builtInteger class = SmallInteger
!
----- Method: IntegerTest>>testCreationFromBytes3 (in category 'tests - instance creation') -----
testCreationFromBytes3
"self run: #testCreationFromBytes3"
"it is illegal for a LargeInteger to be less than SmallInteger maxVal."
"here we test that Integer>>byte!!byte2:byte3:byte4: resconstructs (SmallInteger maxVal - 1) as an instance of SmallInteger. "
| maxSmallInt hexString byte1 byte2 byte3 byte4
builtInteger |
maxSmallInt := SmallInteger maxVal.
hexString := (maxSmallInt - 1) printStringHex.
self assert: hexString size = 8.
byte4 := Number readFrom: (hexString copyFrom: 1 to: 2) base: 16.
byte3 := Number readFrom: (hexString copyFrom: 3 to: 4) base: 16.
byte2 := Number readFrom: (hexString copyFrom: 5 to: 6) base: 16.
byte1 := Number readFrom: (hexString copyFrom: 7 to: 8) base: 16.
builtInteger := Integer byte1: byte1 byte2: byte2 byte3: byte3 byte4: byte4.
self assert: builtInteger = (maxSmallInt - 1).
self assert: builtInteger class = SmallInteger
!
----- Method: IntegerTest>>testCrossSumBase (in category 'testing - arithmetic') -----
testCrossSumBase
"self run: #testCrossSumBase"
self assert: (
((-20 to: 20) collect: [:each | each crossSumBase: 10]) asArray =
#(2 10 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 10 2)).
self assert: (
((-20 to: 20) collect: [:each | each crossSumBase: 2]) asArray =
#(2 3 2 2 1 4 3 3 2 3 2 2 1 3 2 2 1 2 1 1 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2)).
self should: [10 crossSumBase: 1] raise: AssertionFailure!
----- Method: IntegerTest>>testDegreeCos (in category 'tests - basic') -----
testDegreeCos
"self run: #testDegreeCos"
self shouldnt: [ 45 degreeCos] raise: Error.
self assert: 45 degreeCos printString = (2 sqrt / 2) asFloat printString !
----- Method: IntegerTest>>testDifferentBases (in category 'tests - instance creation') -----
testDifferentBases
"self run: #testDifferentBases"
"| value |
2 to: 36 do: [:each|
value := 0.
1 to: each-1 do: [:n| value := value + (n * (each raisedToInteger: n))].
value := value negated.
Transcript tab; show: 'self assert: (', value printString, ' printStringBase: ', each printString, ') = ''', (value printStringBase: each), '''.'; cr.
Transcript tab; show: 'self assert: (', value printString, ' radix: ', each printString, ') = ''', (value radix: each), '''.'; cr.
Transcript tab; show: 'self assert: ', value printString, ' printStringHex = ''', (value printStringBase: 16), '''.'; cr.
Transcript tab; show: 'self assert: (', value printString, ' storeStringBase: ', each printString, ') = ''', (value storeStringBase: each), '''.'; cr.
Transcript tab; show: 'self assert: ', value printString, ' storeStringHex = ''', (value storeStringBase: 16), '''.'; cr.
].
"
self assert: 2r10 = 2.
self assert: 3r210 = 21.
self assert: 4r3210 = 228.
self assert: 5r43210 = 2930.
self assert: 6r543210 = 44790.
self assert: 7r6543210 = 800667.
self assert: 8r76543210 = 16434824.
self assert: 9r876543210 = 381367044.
self assert: 10r9876543210 = 9876543210.
self assert: 11rA9876543210 = 282458553905.
self assert: 12rBA9876543210 = 8842413667692.
self assert: 13rCBA9876543210 = 300771807240918.
self assert: 14rDCBA9876543210 = 11046255305880158.
self assert: 15rEDCBA9876543210 = 435659737878916215.
self assert: 16rFEDCBA9876543210 = 18364758544493064720.
self assert: 17rGFEDCBA9876543210 = 824008854613343261192.
self assert: 18rHGFEDCBA9876543210 = 39210261334551566857170.
self assert: 19rIHGFEDCBA9876543210 = 1972313422155189164466189.
self assert: 20rJIHGFEDCBA9876543210 = 104567135734072022160664820.
self assert: 21rKJIHGFEDCBA9876543210 = 5827980550840017565077671610.
self assert: 22rLKJIHGFEDCBA9876543210 = 340653664490377789692799452102.
self assert: 23rMLKJIHGFEDCBA9876543210 = 20837326537038308910317109288851.
self assert: 24rNMLKJIHGFEDCBA9876543210 = 1331214537196502869015340298036888.
self assert: 25rONMLKJIHGFEDCBA9876543210 = 88663644327703473714387251271141900.
self assert: 26rPONMLKJIHGFEDCBA9876543210 = 6146269788878825859099399609538763450.
self assert: 27rQPONMLKJIHGFEDCBA9876543210 = 442770531899482980347734468443677777577.
self assert: 28rRQPONMLKJIHGFEDCBA9876543210 = 33100056003358651440264672384704297711484.
self assert: 29rSRQPONMLKJIHGFEDCBA9876543210 = 2564411043271974895869785066497940850811934.
self assert: 30rTSRQPONMLKJIHGFEDCBA9876543210 = 205646315052919334126040428061831153388822830.
self assert: 31rUTSRQPONMLKJIHGFEDCBA9876543210 = 17050208381689099029767742314582582184093573615.
self assert: 32rVUTSRQPONMLKJIHGFEDCBA9876543210 = 1459980823972598128486511383358617792788444579872.
self assert: 33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = 128983956064237823710866404905431464703849549412368.
self assert: 34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 11745843093701610854378775891116314824081102660800418.
self assert: 35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 1101553773143634726491620528194292510495517905608180485.
self assert: 36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 106300512100105327644605138221229898724869759421181854980.
self assert: -2r10 = -2.
self assert: -3r210 = -21.
self assert: -4r3210 = -228.
self assert: -5r43210 = -2930.
self assert: -6r543210 = -44790.
self assert: -7r6543210 = -800667.
self assert: -8r76543210 = -16434824.
self assert: -9r876543210 = -381367044.
self assert: -10r9876543210 = -9876543210.
self assert: -11rA9876543210 = -282458553905.
self assert: -12rBA9876543210 = -8842413667692.
self assert: -13rCBA9876543210 = -300771807240918.
self assert: -14rDCBA9876543210 = -11046255305880158.
self assert: -15rEDCBA9876543210 = -435659737878916215.
self assert: -16rFEDCBA9876543210 = -18364758544493064720.
self assert: -17rGFEDCBA9876543210 = -824008854613343261192.
self assert: -18rHGFEDCBA9876543210 = -39210261334551566857170.
self assert: -19rIHGFEDCBA9876543210 = -1972313422155189164466189.
self assert: -20rJIHGFEDCBA9876543210 = -104567135734072022160664820.
self assert: -21rKJIHGFEDCBA9876543210 = -5827980550840017565077671610.
self assert: -22rLKJIHGFEDCBA9876543210 = -340653664490377789692799452102.
self assert: -23rMLKJIHGFEDCBA9876543210 = -20837326537038308910317109288851.
self assert: -24rNMLKJIHGFEDCBA9876543210 = -1331214537196502869015340298036888.
self assert: -25rONMLKJIHGFEDCBA9876543210 = -88663644327703473714387251271141900.
self assert: -26rPONMLKJIHGFEDCBA9876543210 = -6146269788878825859099399609538763450.
self assert: -27rQPONMLKJIHGFEDCBA9876543210 = -442770531899482980347734468443677777577.
self assert: -28rRQPONMLKJIHGFEDCBA9876543210 = -33100056003358651440264672384704297711484.
self assert: -29rSRQPONMLKJIHGFEDCBA9876543210 = -2564411043271974895869785066497940850811934.
self assert: -30rTSRQPONMLKJIHGFEDCBA9876543210 = -205646315052919334126040428061831153388822830.
self assert: -31rUTSRQPONMLKJIHGFEDCBA9876543210 = -17050208381689099029767742314582582184093573615.
self assert: -32rVUTSRQPONMLKJIHGFEDCBA9876543210 = -1459980823972598128486511383358617792788444579872.
self assert: -33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = -128983956064237823710866404905431464703849549412368.
self assert: -34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -11745843093701610854378775891116314824081102660800418.
self assert: -35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -1101553773143634726491620528194292510495517905608180485.
self assert: -36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -106300512100105327644605138221229898724869759421181854980.!
----- Method: IntegerTest>>testEven (in category 'tests - basic') -----
testEven
self deny: (1073741825 even).
self assert: (1073741824 even).
!
----- Method: IntegerTest>>testHex (in category 'tests - printing') -----
testHex
self assert: 0 hex = '0'.
self assert: 12 hex = 'C'.
self assert: 1234 hex = '4D2'.!
----- Method: IntegerTest>>testIntegerByteEncoded (in category 'tests - printing') -----
testIntegerByteEncoded
self assert: (ByteEncoder stream writeNumber: 2 base: 2; yourself) contents = '10'.
self assert: (ByteEncoder stream writeNumber: 21 base: 3; yourself) contents = '210'.
self assert: (ByteEncoder stream writeNumber: 228 base: 4; yourself) contents = '3210'.
self assert: (ByteEncoder stream writeNumber: 2930 base: 5; yourself) contents = '43210'.
self assert: (ByteEncoder stream writeNumber: 44790 base: 6; yourself) contents = '543210'.
self assert: (ByteEncoder stream writeNumber: 800667 base: 7; yourself) contents = '6543210'.
self assert: (ByteEncoder stream writeNumber: 16434824 base: 8; yourself) contents = '76543210'.
self assert: (ByteEncoder stream writeNumber: 381367044 base: 9; yourself) contents = '876543210'.
self assert: (ByteEncoder stream writeNumber: 9876543210 base: 10; yourself) contents = '9876543210'.
self assert: (ByteEncoder stream writeNumber: 282458553905 base: 11; yourself) contents = 'A9876543210'.
self assert: (ByteEncoder stream writeNumber: 8842413667692 base: 12; yourself) contents = 'BA9876543210'.
self assert: (ByteEncoder stream writeNumber: 300771807240918 base: 13; yourself) contents = 'CBA9876543210'.
self assert: (ByteEncoder stream writeNumber: 11046255305880158 base: 14; yourself) contents = 'DCBA9876543210'.
self assert: (ByteEncoder stream writeNumber: 435659737878916215 base: 15; yourself) contents = 'EDCBA9876543210'.
self assert: (ByteEncoder stream writeNumber: 18364758544493064720 base: 16; yourself) contents = 'FEDCBA9876543210'.
self assert: (ByteEncoder stream writeNumber: -2 base: 2; yourself) contents = '-10'.
self assert: (ByteEncoder stream writeNumber: -21 base: 3; yourself) contents = '-210'.
self assert: (ByteEncoder stream writeNumber: -228 base: 4; yourself) contents = '-3210'.
self assert: (ByteEncoder stream writeNumber: -2930 base: 5; yourself) contents = '-43210'.
self assert: (ByteEncoder stream writeNumber: -44790 base: 6; yourself) contents = '-543210'.
self assert: (ByteEncoder stream writeNumber: -800667 base: 7; yourself) contents = '-6543210'.
self assert: (ByteEncoder stream writeNumber: -16434824 base: 8; yourself) contents = '-76543210'.
self assert: (ByteEncoder stream writeNumber: -381367044 base: 9; yourself) contents = '-876543210'.
self assert: (ByteEncoder stream writeNumber: -9876543210 base: 10; yourself) contents = '-9876543210'.
self assert: (ByteEncoder stream writeNumber: -282458553905 base: 11; yourself) contents = '-A9876543210'.
self assert: (ByteEncoder stream writeNumber: -8842413667692 base: 12; yourself) contents = '-BA9876543210'.
self assert: (ByteEncoder stream writeNumber: -300771807240918 base: 13; yourself) contents = '-CBA9876543210'.
self assert: (ByteEncoder stream writeNumber: -11046255305880158 base: 14; yourself) contents = '-DCBA9876543210'.
self assert: (ByteEncoder stream writeNumber: -435659737878916215 base: 15; yourself) contents = '-EDCBA9876543210'.
self assert: (ByteEncoder stream writeNumber: -18364758544493064720 base: 16; yourself) contents = '-FEDCBA9876543210'.!
----- Method: IntegerTest>>testIntegerPadding (in category 'tests - printing') -----
testIntegerPadding
"self run: #testIntegerPadding"
self assert: (1 printStringBase: 10 length: 0 padded: false) = '1'.
self assert: (1 printStringBase: 10 length: 1 padded: false) = '1'.
self assert: (1 printStringBase: 10 length: 2 padded: false) = ' 1'.
self assert: (1024 printStringBase: 10 length: 19 padded: false) = ' 1024'.
self assert: (1024 printStringBase: 10 length: -1 padded: false) = '1024'.
self assert: (1024 printStringBase: 10 length: 5 padded: false) = ' 1024'.
self assert: (-1024 printStringBase: 10 length: 5 padded: false) = '-1024'.
self assert: (-1024 printStringBase: 10 length: 19 padded: false) = ' -1024'.
self assert: (1 printStringBase: 10 length: 0 padded: true) = '1'.
self assert: (1 printStringBase: 10 length: 1 padded: true) = '1'.
self assert: (1 printStringBase: 10 length: 2 padded: true) = '01'.
self assert: (1024 printStringBase: 10 length: 19 padded: true) = '0000000000000001024'.
self assert: (1024 printStringBase: 10 length: -1 padded: true) = '1024'.
self assert: (1024 printStringBase: 10 length: 5 padded: true) = '01024'.
self assert: (-1024 printStringBase: 10 length: 5 padded: true) = '-1024'.
self assert: (-1024 printStringBase: 10 length: 19 padded: true) = '-000000000000001024'.
self assert: (1 printStringBase: 16 length: 0 padded: false) = '1'.
self assert: (1 printStringBase: 16 length: 1 padded: false) = '1'.
self assert: (1 printStringBase: 16 length: 2 padded: false) = ' 1'.
self assert: (2047 printStringBase: 16 length: 19 padded: false) = ' 7FF'.
self assert: (2047 printStringBase: 16 length: -1 padded: false) = '7FF'.
self assert: (2047 printStringBase: 16 length: 4 padded: false) = ' 7FF'.
self assert: (-2047 printStringBase: 16 length: 4 padded: false) = '-7FF'.
self assert: (-2047 printStringBase: 16 length: 19 padded: false) = ' -7FF'.
self assert: (1 printStringBase: 16 length: 0 padded: true) = '1'.
self assert: (1 printStringBase: 16 length: 1 padded: true) = '1'.
self assert: (1 printStringBase: 16 length: 2 padded: true) = '01'.
self assert: (2047 printStringBase: 16 length: 19 padded: true) = '00000000000000007FF'.
self assert: (2047 printStringBase: 16 length: -1 padded: true) = '7FF'.
self assert: (2047 printStringBase: 16 length: 4 padded: true) = '07FF'.
self assert: (-2047 printStringBase: 16 length: 4 padded: true) = '-7FF'.
self assert: (-2047 printStringBase: 16 length: 19 padded: true) = '-0000000000000007FF'.
self assert: (1 storeStringBase: 10 length: 0 padded: false) = '1'.
self assert: (1 storeStringBase: 10 length: 1 padded: false) = '1'.
self assert: (1 storeStringBase: 10 length: 2 padded: false) = ' 1'.
self assert: (1024 storeStringBase: 10 length: 19 padded: false) = ' 1024'.
self assert: (1024 storeStringBase: 10 length: -1 padded: false) = '1024'.
self assert: (1024 storeStringBase: 10 length: 5 padded: false) = ' 1024'.
self assert: (-1024 storeStringBase: 10 length: 5 padded: false) = '-1024'.
self assert: (-1024 storeStringBase: 10 length: 19 padded: false) = ' -1024'.
self assert: (1 storeStringBase: 10 length: 0 padded: true) = '1'.
self assert: (1 storeStringBase: 10 length: 1 padded: true) = '1'.
self assert: (1 storeStringBase: 10 length: 2 padded: true) = '01'.
self assert: (1024 storeStringBase: 10 length: 19 padded: true) = '0000000000000001024'.
self assert: (1024 storeStringBase: 10 length: -1 padded: true) = '1024'.
self assert: (1024 storeStringBase: 10 length: 5 padded: true) = '01024'.
self assert: (-1024 storeStringBase: 10 length: 5 padded: true) = '-1024'.
self assert: (-1024 storeStringBase: 10 length: 19 padded: true) = '-000000000000001024'.
self assert: (1 storeStringBase: 16 length: 0 padded: false) = '16r1'.
self assert: (1 storeStringBase: 16 length: 4 padded: false) = '16r1'.
self assert: (1 storeStringBase: 16 length: 5 padded: false) = ' 16r1'.
self assert: (2047 storeStringBase: 16 length: 19 padded: false) = ' 16r7FF'.
self assert: (2047 storeStringBase: 16 length: -1 padded: false) = '16r7FF'.
self assert: (2047 storeStringBase: 16 length: 7 padded: false) = ' 16r7FF'.
self assert: (-2047 storeStringBase: 16 length: 7 padded: false) = '-16r7FF'.
self assert: (-2047 storeStringBase: 16 length: 19 padded: false) = ' -16r7FF'.
self assert: (1 storeStringBase: 16 length: 0 padded: true) = '16r1'.
self assert: (1 storeStringBase: 16 length: 4 padded: true) = '16r1'.
self assert: (1 storeStringBase: 16 length: 5 padded: true) = '16r01'.
self assert: (2047 storeStringBase: 16 length: 19 padded: true) = '16r00000000000007FF'.
self assert: (2047 storeStringBase: 16 length: -1 padded: true) = '16r7FF'.
self assert: (2047 storeStringBase: 16 length: 7 padded: true) = '16r07FF'.
self assert: (-2047 storeStringBase: 16 length: 7 padded: true) = '-16r7FF'.
self assert: (-2047 storeStringBase: 16 length: 19 padded: true) = '-16r0000000000007FF'.
!
----- Method: IntegerTest>>testIntegerReadFrom (in category 'tests - instance creation') -----
testIntegerReadFrom
self assert: (Integer readFrom: '123' readStream base: 10) = 123.
self assert: (Integer readFrom: '-123' readStream base: 10) = -123.
self assert: (Integer readFrom: 'abc' readStream base: 10) = 0.
self assert: (Integer readFrom: 'D12' readStream base: 10) = 0.
self assert: (Integer readFrom: '1two3' readStream base: 10) = 1.
!
----- Method: IntegerTest>>testIsInteger (in category 'tests - basic') -----
testIsInteger
self assert: (0 isInteger).
!
----- Method: IntegerTest>>testIsPowerOfTwo (in category 'tests - basic') -----
testIsPowerOfTwo
self assert: (0 isPowerOfTwo).
self assert: (1 isPowerOfTwo).
self assert: (2 isPowerOfTwo).
self deny: (3 isPowerOfTwo).
self assert: (4 isPowerOfTwo).
!
----- Method: IntegerTest>>testIsPrime (in category 'tests - basic') -----
testIsPrime
"The following tests should return 'true'"
self assert: 17 isPrime.
self assert: 78901 isPrime.
self assert: 104729 isPrime.
self assert: 15485863 isPrime.
self assert: 2038074743 isPrime.
self assert: 29996224275833 isPrime.
"The following tests should return 'false' (first 5 are Carmichael integers)"
self deny: 561 isPrime.
self deny: 2821 isPrime.
self deny: 6601 isPrime.
self deny: 10585 isPrime.
self deny: 15841 isPrime.
self deny: 256 isPrime.
self deny: 29996224275831 isPrime.!
----- Method: IntegerTest>>testLargePrimesUpTo (in category 'tests - basic') -----
testLargePrimesUpTo
| nn |
nn := (2 raisedTo: 17) - 1.
self deny: (Integer primesUpTo: nn) last = nn.
self assert: (Integer primesUpTo: nn + 1) last = nn.
!
----- Method: IntegerTest>>testNegativeIntegerPrinting (in category 'tests - printing') -----
testNegativeIntegerPrinting
"self run: #testnegativeIntegerPrinting"
self assert: (-2 printStringBase: 2) = '-10'.
self assert: (-2 radix: 2) = '-10'.
self assert: -2 printStringHex = '-2'.
self assert: (-2 storeStringBase: 2) = '-2r10'.
self assert: -2 storeStringHex = '-16r2'.
self assert: (-21 printStringBase: 3) = '-210'.
self assert: (-21 radix: 3) = '-210'.
self assert: -21 printStringHex = '-15'.
self assert: (-21 storeStringBase: 3) = '-3r210'.
self assert: -21 storeStringHex = '-16r15'.
self assert: (-228 printStringBase: 4) = '-3210'.
self assert: (-228 radix: 4) = '-3210'.
self assert: -228 printStringHex = '-E4'.
self assert: (-228 storeStringBase: 4) = '-4r3210'.
self assert: -228 storeStringHex = '-16rE4'.
self assert: (-2930 printStringBase: 5) = '-43210'.
self assert: (-2930 radix: 5) = '-43210'.
self assert: -2930 printStringHex = '-B72'.
self assert: (-2930 storeStringBase: 5) = '-5r43210'.
self assert: -2930 storeStringHex = '-16rB72'.
self assert: (-44790 printStringBase: 6) = '-543210'.
self assert: (-44790 radix: 6) = '-543210'.
self assert: -44790 printStringHex = '-AEF6'.
self assert: (-44790 storeStringBase: 6) = '-6r543210'.
self assert: -44790 storeStringHex = '-16rAEF6'.
self assert: (-800667 printStringBase: 7) = '-6543210'.
self assert: (-800667 radix: 7) = '-6543210'.
self assert: -800667 printStringHex = '-C379B'.
self assert: (-800667 storeStringBase: 7) = '-7r6543210'.
self assert: -800667 storeStringHex = '-16rC379B'.
self assert: (-16434824 printStringBase: 8) = '-76543210'.
self assert: (-16434824 radix: 8) = '-76543210'.
self assert: -16434824 printStringHex = '-FAC688'.
self assert: (-16434824 storeStringBase: 8) = '-8r76543210'.
self assert: -16434824 storeStringHex = '-16rFAC688'.
self assert: (-381367044 printStringBase: 9) = '-876543210'.
self assert: (-381367044 radix: 9) = '-876543210'.
self assert: -381367044 printStringHex = '-16BB3304'.
self assert: (-381367044 storeStringBase: 9) = '-9r876543210'.
self assert: -381367044 storeStringHex = '-16r16BB3304'.
self assert: (-9876543210 printStringBase: 10) = '-9876543210'.
self assert: (-9876543210 radix: 10) = '-9876543210'.
self assert: -9876543210 printStringHex = '-24CB016EA'.
self assert: (-9876543210 storeStringBase: 10) = '-9876543210'.
self assert: -9876543210 storeStringHex = '-16r24CB016EA'.
self assert: (-282458553905 printStringBase: 11) = '-A9876543210'.
self assert: (-282458553905 radix: 11) = '-A9876543210'.
self assert: -282458553905 printStringHex = '-41C3D77E31'.
self assert: (-282458553905 storeStringBase: 11) = '-11rA9876543210'.
self assert: -282458553905 storeStringHex = '-16r41C3D77E31'.
self assert: (-8842413667692 printStringBase: 12) = '-BA9876543210'.
self assert: (-8842413667692 radix: 12) = '-BA9876543210'.
self assert: -8842413667692 printStringHex = '-80AC8ECF56C'.
self assert: (-8842413667692 storeStringBase: 12) = '-12rBA9876543210'.
self assert: -8842413667692 storeStringHex = '-16r80AC8ECF56C'.
self assert: (-300771807240918 printStringBase: 13) = '-CBA9876543210'.
self assert: (-300771807240918 radix: 13) = '-CBA9876543210'.
self assert: -300771807240918 printStringHex = '-1118CE4BAA2D6'.
self assert: (-300771807240918 storeStringBase: 13) = '-13rCBA9876543210'.
self assert: -300771807240918 storeStringHex = '-16r1118CE4BAA2D6'.
self assert: (-11046255305880158 printStringBase: 14) = '-DCBA9876543210'.
self assert: (-11046255305880158 radix: 14) = '-DCBA9876543210'.
self assert: -11046255305880158 printStringHex = '-273E82BB9AF25E'.
self assert: (-11046255305880158 storeStringBase: 14) = '-14rDCBA9876543210'.
self assert: -11046255305880158 storeStringHex = '-16r273E82BB9AF25E'.
self assert: (-435659737878916215 printStringBase: 15) = '-EDCBA9876543210'.
self assert: (-435659737878916215 radix: 15) = '-EDCBA9876543210'.
self assert: -435659737878916215 printStringHex = '-60BC6392F366C77'.
self assert: (-435659737878916215 storeStringBase: 15) = '-15rEDCBA9876543210'.
self assert: -435659737878916215 storeStringHex = '-16r60BC6392F366C77'.
self assert: (-18364758544493064720 printStringBase: 16) = '-FEDCBA9876543210'.
self assert: (-18364758544493064720 radix: 16) = '-FEDCBA9876543210'.
self assert: -18364758544493064720 printStringHex = '-FEDCBA9876543210'.
self assert: (-18364758544493064720 storeStringBase: 16) = '-16rFEDCBA9876543210'.
self assert: -18364758544493064720 storeStringHex = '-16rFEDCBA9876543210'.
self assert: (-824008854613343261192 printStringBase: 17) = '-GFEDCBA9876543210'.
self assert: (-824008854613343261192 radix: 17) = '-GFEDCBA9876543210'.
self assert: -824008854613343261192 printStringHex = '-2CAB6B877C1CD2D208'.
self assert: (-824008854613343261192 storeStringBase: 17) = '-17rGFEDCBA9876543210'.
self assert: -824008854613343261192 storeStringHex = '-16r2CAB6B877C1CD2D208'.
self assert: (-39210261334551566857170 printStringBase: 18) = '-HGFEDCBA9876543210'.
self assert: (-39210261334551566857170 radix: 18) = '-HGFEDCBA9876543210'.
self assert: -39210261334551566857170 printStringHex = '-84D97AFCAE81415B3D2'.
self assert: (-39210261334551566857170 storeStringBase: 18) = '-18rHGFEDCBA9876543210'.
self assert: -39210261334551566857170 storeStringHex = '-16r84D97AFCAE81415B3D2'.
self assert: (-1972313422155189164466189 printStringBase: 19) = '-IHGFEDCBA9876543210'.
self assert: (-1972313422155189164466189 radix: 19) = '-IHGFEDCBA9876543210'.
self assert: -1972313422155189164466189 printStringHex = '-1A1A75329C5C6FC00600D'.
self assert: (-1972313422155189164466189 storeStringBase: 19) = '-19rIHGFEDCBA9876543210'.
self assert: -1972313422155189164466189 storeStringHex = '-16r1A1A75329C5C6FC00600D'.
self assert: (-104567135734072022160664820 printStringBase: 20) = '-JIHGFEDCBA9876543210'.
self assert: (-104567135734072022160664820 radix: 20) = '-JIHGFEDCBA9876543210'.
self assert: -104567135734072022160664820 printStringHex = '-567EF3C9636D242A8C68F4'.
self assert: (-104567135734072022160664820 storeStringBase: 20) = '-20rJIHGFEDCBA9876543210'.
self assert: -104567135734072022160664820 storeStringHex = '-16r567EF3C9636D242A8C68F4'.
self assert: (-5827980550840017565077671610 printStringBase: 21) = '-KJIHGFEDCBA9876543210'.
self assert: (-5827980550840017565077671610 radix: 21) = '-KJIHGFEDCBA9876543210'.
self assert: -5827980550840017565077671610 printStringHex = '-12D4CAE2B8A09BCFDBE30EBA'.
self assert: (-5827980550840017565077671610 storeStringBase: 21) = '-21rKJIHGFEDCBA9876543210'.
self assert: -5827980550840017565077671610 storeStringHex = '-16r12D4CAE2B8A09BCFDBE30EBA'.
self assert: (-340653664490377789692799452102 printStringBase: 22) = '-LKJIHGFEDCBA9876543210'.
self assert: (-340653664490377789692799452102 radix: 22) = '-LKJIHGFEDCBA9876543210'.
self assert: -340653664490377789692799452102 printStringHex = '-44CB61B5B47E1A5D8F88583C6'.
self assert: (-340653664490377789692799452102 storeStringBase: 22) = '-22rLKJIHGFEDCBA9876543210'.
self assert: -340653664490377789692799452102 storeStringHex = '-16r44CB61B5B47E1A5D8F88583C6'.
self assert: (-20837326537038308910317109288851 printStringBase: 23) = '-MLKJIHGFEDCBA9876543210'.
self assert: (-20837326537038308910317109288851 radix: 23) = '-MLKJIHGFEDCBA9876543210'.
self assert: -20837326537038308910317109288851 printStringHex = '-1070108876456E0EF115B389F93'.
self assert: (-20837326537038308910317109288851 storeStringBase: 23) = '-23rMLKJIHGFEDCBA9876543210'.
self assert: -20837326537038308910317109288851 storeStringHex = '-16r1070108876456E0EF115B389F93'.
self assert: (-1331214537196502869015340298036888 printStringBase: 24) = '-NMLKJIHGFEDCBA9876543210'.
self assert: (-1331214537196502869015340298036888 radix: 24) = '-NMLKJIHGFEDCBA9876543210'.
self assert: -1331214537196502869015340298036888 printStringHex = '-41A24A285154B026B6ED206C6698'.
self assert: (-1331214537196502869015340298036888 storeStringBase: 24) = '-24rNMLKJIHGFEDCBA9876543210'.
self assert: -1331214537196502869015340298036888 storeStringHex = '-16r41A24A285154B026B6ED206C6698'.
self assert: (-88663644327703473714387251271141900 printStringBase: 25) = '-ONMLKJIHGFEDCBA9876543210'.
self assert: (-88663644327703473714387251271141900 radix: 25) = '-ONMLKJIHGFEDCBA9876543210'.
self assert: -88663644327703473714387251271141900 printStringHex = '-111374860A2C6CEBE5999630398A0C'.
self assert: (-88663644327703473714387251271141900 storeStringBase: 25) = '-25rONMLKJIHGFEDCBA9876543210'.
self assert: -88663644327703473714387251271141900 storeStringHex = '-16r111374860A2C6CEBE5999630398A0C'.
self assert: (-6146269788878825859099399609538763450 printStringBase: 26) = '-PONMLKJIHGFEDCBA9876543210'.
self assert: (-6146269788878825859099399609538763450 radix: 26) = '-PONMLKJIHGFEDCBA9876543210'.
self assert: -6146269788878825859099399609538763450 printStringHex = '-49FBA7F30B0F48BD14E6A99BD8ADABA'.
self assert: (-6146269788878825859099399609538763450 storeStringBase: 26) = '-26rPONMLKJIHGFEDCBA9876543210'.
self assert: -6146269788878825859099399609538763450 storeStringHex = '-16r49FBA7F30B0F48BD14E6A99BD8ADABA'.
self assert: (-442770531899482980347734468443677777577 printStringBase: 27) = '-QPONMLKJIHGFEDCBA9876543210'.
self assert: (-442770531899482980347734468443677777577 radix: 27) = '-QPONMLKJIHGFEDCBA9876543210'.
self assert: -442770531899482980347734468443677777577 printStringHex = '-14D1A80A997343640C1145A073731DEA9'.
self assert: (-442770531899482980347734468443677777577 storeStringBase: 27) = '-27rQPONMLKJIHGFEDCBA9876543210'.
self assert: -442770531899482980347734468443677777577 storeStringHex = '-16r14D1A80A997343640C1145A073731DEA9'.
self assert: (-33100056003358651440264672384704297711484 printStringBase: 28) = '-RQPONMLKJIHGFEDCBA9876543210'.
self assert: (-33100056003358651440264672384704297711484 radix: 28) = '-RQPONMLKJIHGFEDCBA9876543210'.
self assert: -33100056003358651440264672384704297711484 printStringHex = '-6145B6E6DACFA25D0E936F51D25932377C'.
self assert: (-33100056003358651440264672384704297711484 storeStringBase: 28) = '-28rRQPONMLKJIHGFEDCBA9876543210'.
self assert: -33100056003358651440264672384704297711484 storeStringHex = '-16r6145B6E6DACFA25D0E936F51D25932377C'.
self assert: (-2564411043271974895869785066497940850811934 printStringBase: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-2564411043271974895869785066497940850811934 radix: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'.
self assert: -2564411043271974895869785066497940850811934 printStringHex = '-1D702071CBA4A1597D4DD37E95EFAC79241E'.
self assert: (-2564411043271974895869785066497940850811934 storeStringBase: 29) = '-29rSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -2564411043271974895869785066497940850811934 storeStringHex = '-16r1D702071CBA4A1597D4DD37E95EFAC79241E'.
self assert: (-205646315052919334126040428061831153388822830 printStringBase: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-205646315052919334126040428061831153388822830 radix: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -205646315052919334126040428061831153388822830 printStringHex = '-938B4343B54B550989989D02998718FFB212E'.
self assert: (-205646315052919334126040428061831153388822830 storeStringBase: 30) = '-30rTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -205646315052919334126040428061831153388822830 storeStringHex = '-16r938B4343B54B550989989D02998718FFB212E'.
self assert: (-17050208381689099029767742314582582184093573615 printStringBase: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-17050208381689099029767742314582582184093573615 radix: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -17050208381689099029767742314582582184093573615 printStringHex = '-2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
self assert: (-17050208381689099029767742314582582184093573615 storeStringBase: 31) = '-31rUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -17050208381689099029767742314582582184093573615 storeStringHex = '-16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
self assert: (-1459980823972598128486511383358617792788444579872 printStringBase: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-1459980823972598128486511383358617792788444579872 radix: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -1459980823972598128486511383358617792788444579872 printStringHex = '-FFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
self assert: (-1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '-32rVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -1459980823972598128486511383358617792788444579872 storeStringHex = '-16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
self assert: (-128983956064237823710866404905431464703849549412368 printStringBase: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-128983956064237823710866404905431464703849549412368 radix: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -128983956064237823710866404905431464703849549412368 printStringHex = '-584120A0328DE272AB055A8AA003CE4A559F223810'.
self assert: (-128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '-33rWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -128983956064237823710866404905431464703849549412368 storeStringHex = '-16r584120A0328DE272AB055A8AA003CE4A559F223810'.
self assert: (-11745843093701610854378775891116314824081102660800418 printStringBase: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-11745843093701610854378775891116314824081102660800418 radix: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -11745843093701610854378775891116314824081102660800418 printStringHex = '-1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
self assert: (-11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '-34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -11745843093701610854378775891116314824081102660800418 storeStringHex = '-16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
self assert: (-1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-1101553773143634726491620528194292510495517905608180485 radix: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -1101553773143634726491620528194292510495517905608180485 printStringHex = '-B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
self assert: (-1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '-35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -1101553773143634726491620528194292510495517905608180485 storeStringHex = '-16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
self assert: (-106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (-106300512100105327644605138221229898724869759421181854980 radix: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -106300512100105327644605138221229898724869759421181854980 printStringHex = '-455D441E55A37239AB4C303189576071AF5578FFCA80504'.
self assert: (-106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '-36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: -106300512100105327644605138221229898724869759421181854980 storeStringHex = '-16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.!
----- Method: IntegerTest>>testNew (in category 'tests - instance creation') -----
testNew
self should: [Integer new] raise: TestResult error. !
----- Method: IntegerTest>>testNumberOfDigits (in category 'tests - printing') -----
testNumberOfDigits
2 to: 32 do: [:b |
1 to: 1000//b do: [:n |
| bRaisedToN |
bRaisedToN := b raisedTo: n.
self assert: (bRaisedToN - 1 numberOfDigitsInBase: b) = n.
self assert: (bRaisedToN numberOfDigitsInBase: b) = (n+1).
self assert: (bRaisedToN + 1 numberOfDigitsInBase: b) = (n+1).
self assert: (bRaisedToN negated + 1 numberOfDigitsInBase: b) = n.
self assert: (bRaisedToN negated numberOfDigitsInBase: b) = (n+1).
self assert: (bRaisedToN negated - 1 numberOfDigitsInBase: b) = (n+1).]].
!
----- Method: IntegerTest>>testPositiveIntegerPrinting (in category 'tests - printing') -----
testPositiveIntegerPrinting
"self run: #testPositiveIntegerPrinting"
self assert: 0 printString = '0'.
self assert: 0 printStringHex = '0'.
self assert: 0 storeStringHex = '16r0'.
self assert: (2 printStringBase: 2) = '10'.
self assert: (2 radix: 2) = '10'.
self assert: 2 printStringHex = '2'.
self assert: (2 storeStringBase: 2) = '2r10'.
self assert: 2 storeStringHex = '16r2'.
self assert: (21 printStringBase: 3) = '210'.
self assert: (21 radix: 3) = '210'.
self assert: 21 printStringHex = '15'.
self assert: (21 storeStringBase: 3) = '3r210'.
self assert: 21 storeStringHex = '16r15'.
self assert: (228 printStringBase: 4) = '3210'.
self assert: (228 radix: 4) = '3210'.
self assert: 228 printStringHex = 'E4'.
self assert: (228 storeStringBase: 4) = '4r3210'.
self assert: 228 storeStringHex = '16rE4'.
self assert: (2930 printStringBase: 5) = '43210'.
self assert: (2930 radix: 5) = '43210'.
self assert: 2930 printStringHex = 'B72'.
self assert: (2930 storeStringBase: 5) = '5r43210'.
self assert: 2930 storeStringHex = '16rB72'.
self assert: (44790 printStringBase: 6) = '543210'.
self assert: (44790 radix: 6) = '543210'.
self assert: 44790 printStringHex = 'AEF6'.
self assert: (44790 storeStringBase: 6) = '6r543210'.
self assert: 44790 storeStringHex = '16rAEF6'.
self assert: (800667 printStringBase: 7) = '6543210'.
self assert: (800667 radix: 7) = '6543210'.
self assert: 800667 printStringHex = 'C379B'.
self assert: (800667 storeStringBase: 7) = '7r6543210'.
self assert: 800667 storeStringHex = '16rC379B'.
self assert: (16434824 printStringBase: 8) = '76543210'.
self assert: (16434824 radix: 8) = '76543210'.
self assert: 16434824 printStringHex = 'FAC688'.
self assert: (16434824 storeStringBase: 8) = '8r76543210'.
self assert: 16434824 storeStringHex = '16rFAC688'.
self assert: (381367044 printStringBase: 9) = '876543210'.
self assert: (381367044 radix: 9) = '876543210'.
self assert: 381367044 printStringHex = '16BB3304'.
self assert: (381367044 storeStringBase: 9) = '9r876543210'.
self assert: 381367044 storeStringHex = '16r16BB3304'.
self assert: (9876543210 printStringBase: 10) = '9876543210'.
self assert: (9876543210 radix: 10) = '9876543210'.
self assert: 9876543210 printStringHex = '24CB016EA'.
self assert: (9876543210 storeStringBase: 10) = '9876543210'.
self assert: 9876543210 storeStringHex = '16r24CB016EA'.
self assert: (282458553905 printStringBase: 11) = 'A9876543210'.
self assert: (282458553905 radix: 11) = 'A9876543210'.
self assert: 282458553905 printStringHex = '41C3D77E31'.
self assert: (282458553905 storeStringBase: 11) = '11rA9876543210'.
self assert: 282458553905 storeStringHex = '16r41C3D77E31'.
self assert: (8842413667692 printStringBase: 12) = 'BA9876543210'.
self assert: (8842413667692 radix: 12) = 'BA9876543210'.
self assert: 8842413667692 printStringHex = '80AC8ECF56C'.
self assert: (8842413667692 storeStringBase: 12) = '12rBA9876543210'.
self assert: 8842413667692 storeStringHex = '16r80AC8ECF56C'.
self assert: (300771807240918 printStringBase: 13) = 'CBA9876543210'.
self assert: (300771807240918 radix: 13) = 'CBA9876543210'.
self assert: 300771807240918 printStringHex = '1118CE4BAA2D6'.
self assert: (300771807240918 storeStringBase: 13) = '13rCBA9876543210'.
self assert: 300771807240918 storeStringHex = '16r1118CE4BAA2D6'.
self assert: (11046255305880158 printStringBase: 14) = 'DCBA9876543210'.
self assert: (11046255305880158 radix: 14) = 'DCBA9876543210'.
self assert: 11046255305880158 printStringHex = '273E82BB9AF25E'.
self assert: (11046255305880158 storeStringBase: 14) = '14rDCBA9876543210'.
self assert: 11046255305880158 storeStringHex = '16r273E82BB9AF25E'.
self assert: (435659737878916215 printStringBase: 15) = 'EDCBA9876543210'.
self assert: (435659737878916215 radix: 15) = 'EDCBA9876543210'.
self assert: 435659737878916215 printStringHex = '60BC6392F366C77'.
self assert: (435659737878916215 storeStringBase: 15) = '15rEDCBA9876543210'.
self assert: 435659737878916215 storeStringHex = '16r60BC6392F366C77'.
self assert: (18364758544493064720 printStringBase: 16) = 'FEDCBA9876543210'.
self assert: (18364758544493064720 radix: 16) = 'FEDCBA9876543210'.
self assert: 18364758544493064720 printStringHex = 'FEDCBA9876543210'.
self assert: (18364758544493064720 storeStringBase: 16) = '16rFEDCBA9876543210'.
self assert: 18364758544493064720 storeStringHex = '16rFEDCBA9876543210'.
self assert: (824008854613343261192 printStringBase: 17) = 'GFEDCBA9876543210'.
self assert: (824008854613343261192 radix: 17) = 'GFEDCBA9876543210'.
self assert: 824008854613343261192 printStringHex = '2CAB6B877C1CD2D208'.
self assert: (824008854613343261192 storeStringBase: 17) = '17rGFEDCBA9876543210'.
self assert: 824008854613343261192 storeStringHex = '16r2CAB6B877C1CD2D208'.
self assert: (39210261334551566857170 printStringBase: 18) = 'HGFEDCBA9876543210'.
self assert: (39210261334551566857170 radix: 18) = 'HGFEDCBA9876543210'.
self assert: 39210261334551566857170 printStringHex = '84D97AFCAE81415B3D2'.
self assert: (39210261334551566857170 storeStringBase: 18) = '18rHGFEDCBA9876543210'.
self assert: 39210261334551566857170 storeStringHex = '16r84D97AFCAE81415B3D2'.
self assert: (1972313422155189164466189 printStringBase: 19) = 'IHGFEDCBA9876543210'.
self assert: (1972313422155189164466189 radix: 19) = 'IHGFEDCBA9876543210'.
self assert: 1972313422155189164466189 printStringHex = '1A1A75329C5C6FC00600D'.
self assert: (1972313422155189164466189 storeStringBase: 19) = '19rIHGFEDCBA9876543210'.
self assert: 1972313422155189164466189 storeStringHex = '16r1A1A75329C5C6FC00600D'.
self assert: (104567135734072022160664820 printStringBase: 20) = 'JIHGFEDCBA9876543210'.
self assert: (104567135734072022160664820 radix: 20) = 'JIHGFEDCBA9876543210'.
self assert: 104567135734072022160664820 printStringHex = '567EF3C9636D242A8C68F4'.
self assert: (104567135734072022160664820 storeStringBase: 20) = '20rJIHGFEDCBA9876543210'.
self assert: 104567135734072022160664820 storeStringHex = '16r567EF3C9636D242A8C68F4'.
self assert: (5827980550840017565077671610 printStringBase: 21) = 'KJIHGFEDCBA9876543210'.
self assert: (5827980550840017565077671610 radix: 21) = 'KJIHGFEDCBA9876543210'.
self assert: 5827980550840017565077671610 printStringHex = '12D4CAE2B8A09BCFDBE30EBA'.
self assert: (5827980550840017565077671610 storeStringBase: 21) = '21rKJIHGFEDCBA9876543210'.
self assert: 5827980550840017565077671610 storeStringHex = '16r12D4CAE2B8A09BCFDBE30EBA'.
self assert: (340653664490377789692799452102 printStringBase: 22) = 'LKJIHGFEDCBA9876543210'.
self assert: (340653664490377789692799452102 radix: 22) = 'LKJIHGFEDCBA9876543210'.
self assert: 340653664490377789692799452102 printStringHex = '44CB61B5B47E1A5D8F88583C6'.
self assert: (340653664490377789692799452102 storeStringBase: 22) = '22rLKJIHGFEDCBA9876543210'.
self assert: 340653664490377789692799452102 storeStringHex = '16r44CB61B5B47E1A5D8F88583C6'.
self assert: (20837326537038308910317109288851 printStringBase: 23) = 'MLKJIHGFEDCBA9876543210'.
self assert: (20837326537038308910317109288851 radix: 23) = 'MLKJIHGFEDCBA9876543210'.
self assert: 20837326537038308910317109288851 printStringHex = '1070108876456E0EF115B389F93'.
self assert: (20837326537038308910317109288851 storeStringBase: 23) = '23rMLKJIHGFEDCBA9876543210'.
self assert: 20837326537038308910317109288851 storeStringHex = '16r1070108876456E0EF115B389F93'.
self assert: (1331214537196502869015340298036888 printStringBase: 24) = 'NMLKJIHGFEDCBA9876543210'.
self assert: (1331214537196502869015340298036888 radix: 24) = 'NMLKJIHGFEDCBA9876543210'.
self assert: 1331214537196502869015340298036888 printStringHex = '41A24A285154B026B6ED206C6698'.
self assert: (1331214537196502869015340298036888 storeStringBase: 24) = '24rNMLKJIHGFEDCBA9876543210'.
self assert: 1331214537196502869015340298036888 storeStringHex = '16r41A24A285154B026B6ED206C6698'.
self assert: (88663644327703473714387251271141900 printStringBase: 25) = 'ONMLKJIHGFEDCBA9876543210'.
self assert: (88663644327703473714387251271141900 radix: 25) = 'ONMLKJIHGFEDCBA9876543210'.
self assert: 88663644327703473714387251271141900 printStringHex = '111374860A2C6CEBE5999630398A0C'.
self assert: (88663644327703473714387251271141900 storeStringBase: 25) = '25rONMLKJIHGFEDCBA9876543210'.
self assert: 88663644327703473714387251271141900 storeStringHex = '16r111374860A2C6CEBE5999630398A0C'.
self assert: (6146269788878825859099399609538763450 printStringBase: 26) = 'PONMLKJIHGFEDCBA9876543210'.
self assert: (6146269788878825859099399609538763450 radix: 26) = 'PONMLKJIHGFEDCBA9876543210'.
self assert: 6146269788878825859099399609538763450 printStringHex = '49FBA7F30B0F48BD14E6A99BD8ADABA'.
self assert: (6146269788878825859099399609538763450 storeStringBase: 26) = '26rPONMLKJIHGFEDCBA9876543210'.
self assert: 6146269788878825859099399609538763450 storeStringHex = '16r49FBA7F30B0F48BD14E6A99BD8ADABA'.
self assert: (442770531899482980347734468443677777577 printStringBase: 27) = 'QPONMLKJIHGFEDCBA9876543210'.
self assert: (442770531899482980347734468443677777577 radix: 27) = 'QPONMLKJIHGFEDCBA9876543210'.
self assert: 442770531899482980347734468443677777577 printStringHex = '14D1A80A997343640C1145A073731DEA9'.
self assert: (442770531899482980347734468443677777577 storeStringBase: 27) = '27rQPONMLKJIHGFEDCBA9876543210'.
self assert: 442770531899482980347734468443677777577 storeStringHex = '16r14D1A80A997343640C1145A073731DEA9'.
self assert: (33100056003358651440264672384704297711484 printStringBase: 28) = 'RQPONMLKJIHGFEDCBA9876543210'.
self assert: (33100056003358651440264672384704297711484 radix: 28) = 'RQPONMLKJIHGFEDCBA9876543210'.
self assert: 33100056003358651440264672384704297711484 printStringHex = '6145B6E6DACFA25D0E936F51D25932377C'.
self assert: (33100056003358651440264672384704297711484 storeStringBase: 28) = '28rRQPONMLKJIHGFEDCBA9876543210'.
self assert: 33100056003358651440264672384704297711484 storeStringHex = '16r6145B6E6DACFA25D0E936F51D25932377C'.
self assert: (2564411043271974895869785066497940850811934 printStringBase: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'.
self assert: (2564411043271974895869785066497940850811934 radix: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'.
self assert: 2564411043271974895869785066497940850811934 printStringHex = '1D702071CBA4A1597D4DD37E95EFAC79241E'.
self assert: (2564411043271974895869785066497940850811934 storeStringBase: 29) = '29rSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 2564411043271974895869785066497940850811934 storeStringHex = '16r1D702071CBA4A1597D4DD37E95EFAC79241E'.
self assert: (205646315052919334126040428061831153388822830 printStringBase: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (205646315052919334126040428061831153388822830 radix: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 205646315052919334126040428061831153388822830 printStringHex = '938B4343B54B550989989D02998718FFB212E'.
self assert: (205646315052919334126040428061831153388822830 storeStringBase: 30) = '30rTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 205646315052919334126040428061831153388822830 storeStringHex = '16r938B4343B54B550989989D02998718FFB212E'.
self assert: (17050208381689099029767742314582582184093573615 printStringBase: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (17050208381689099029767742314582582184093573615 radix: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 17050208381689099029767742314582582184093573615 printStringHex = '2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
self assert: (17050208381689099029767742314582582184093573615 storeStringBase: 31) = '31rUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 17050208381689099029767742314582582184093573615 storeStringHex = '16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'.
self assert: (1459980823972598128486511383358617792788444579872 printStringBase: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (1459980823972598128486511383358617792788444579872 radix: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 1459980823972598128486511383358617792788444579872 printStringHex = 'FFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
self assert: (1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '32rVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 1459980823972598128486511383358617792788444579872 storeStringHex = '16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'.
self assert: (128983956064237823710866404905431464703849549412368 printStringBase: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (128983956064237823710866404905431464703849549412368 radix: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 128983956064237823710866404905431464703849549412368 printStringHex = '584120A0328DE272AB055A8AA003CE4A559F223810'.
self assert: (128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '33rWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 128983956064237823710866404905431464703849549412368 storeStringHex = '16r584120A0328DE272AB055A8AA003CE4A559F223810'.
self assert: (11745843093701610854378775891116314824081102660800418 printStringBase: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (11745843093701610854378775891116314824081102660800418 radix: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 11745843093701610854378775891116314824081102660800418 printStringHex = '1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
self assert: (11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 11745843093701610854378775891116314824081102660800418 storeStringHex = '16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'.
self assert: (1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (1101553773143634726491620528194292510495517905608180485 radix: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 1101553773143634726491620528194292510495517905608180485 printStringHex = 'B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
self assert: (1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 1101553773143634726491620528194292510495517905608180485 storeStringHex = '16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'.
self assert: (106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: (106300512100105327644605138221229898724869759421181854980 radix: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 106300512100105327644605138221229898724869759421181854980 printStringHex = '455D441E55A37239AB4C303189576071AF5578FFCA80504'.
self assert: (106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'.
self assert: 106300512100105327644605138221229898724869759421181854980 storeStringHex = '16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.!
----- Method: IntegerTest>>testPrimesUpTo (in category 'tests - basic') -----
testPrimesUpTo
| primes nn|
primes := Integer primesUpTo: 100.
self assert: primes = #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97).
"upTo: semantics means 'non-inclusive'"
primes := Integer primesUpTo: 5.
self assert: primes = #(2 3).
"this test is green for nn>25000, see #testLargePrimesUpTo"
nn := 5.
self deny: (Integer primesUpTo: nn) last = nn.
self assert: (Integer primesUpTo: nn + 1) last = nn.!
----- Method: IntegerTest>>testPrintOnBaseShowRadix (in category 'tests - printing') -----
testPrintOnBaseShowRadix
| s |
s := ReadWriteStream on: ''.
123 printOn: s base: 10 showRadix: false.
self assert: (s contents = '123').
s := ReadWriteStream on: ''.
123 printOn: s base: 10 showRadix: true.
self assert: (s contents = '10r123').
s := ReadWriteStream on: ''.
123 printOn: s base: 8 showRadix: false.
self assert: (s contents = '173').
s := ReadWriteStream on: ''.
123 printOn: s base: 8 showRadix: true.
self assert: (s contents = '8r173').!
----- Method: IntegerTest>>testPrintStringBase (in category 'tests - printing') -----
testPrintStringBase
2 to: 32 do: [:b |
1 to: 1000//b do: [:n |
| bRaisedToN |
bRaisedToN := b raisedTo: n.
self assert: (bRaisedToN - 1 printStringBase: b) = (String new: n withAll: (Character digitValue: b-1)).
self assert: (bRaisedToN printStringBase: b) = ('1' , (String new: n withAll: $0)).
self assert: (bRaisedToN negated + 1 printStringBase: b) = ('-' , (String new: n withAll: (Character digitValue: b-1))).
self assert: (bRaisedToN negated printStringBase: b) = ('-1' , (String new: n withAll: $0))]].
!
----- Method: IntegerTest>>testReadFrom (in category 'tests - instance creation') -----
testReadFrom
"Ensure remaining characters in a stream are not lost when parsing an integer."
| rs i s |
rs := '123s could be confused with a ScaledDecimal' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: 's could be confused with a ScaledDecimal' = s.
rs := '123.s could be confused with a ScaledDecimal' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: '.s could be confused with a ScaledDecimal' = s!
----- Method: IntegerTest>>testRomanPrinting (in category 'tests - printing') -----
testRomanPrinting
self assert: 0 printStringRoman = ''. "No symbol for zero"
self assert: 1 printStringRoman = 'I'.
self assert: 2 printStringRoman = 'II'.
self assert: 3 printStringRoman = 'III'.
self assert: 4 printStringRoman = 'IV'.
self assert: 5 printStringRoman = 'V'.
self assert: 6 printStringRoman = 'VI'.
self assert: 7 printStringRoman = 'VII'.
self assert: 8 printStringRoman = 'VIII'.
self assert: 9 printStringRoman = 'IX'.
self assert: 10 printStringRoman = 'X'.
self assert: 23 printStringRoman = 'XXIII'.
self assert: 36 printStringRoman = 'XXXVI'.
self assert: 49 printStringRoman = 'XLIX'.
self assert: 62 printStringRoman = 'LXII'.
self assert: 75 printStringRoman = 'LXXV'.
self assert: 88 printStringRoman = 'LXXXVIII'.
self assert: 99 printStringRoman = 'XCIX'.
self assert: 100 printStringRoman = 'C'.
self assert: 101 printStringRoman = 'CI'.
self assert: 196 printStringRoman = 'CXCVI'.
self assert: 197 printStringRoman = 'CXCVII'.
self assert: 198 printStringRoman = 'CXCVIII'.
self assert: 293 printStringRoman = 'CCXCIII'.
self assert: 294 printStringRoman = 'CCXCIV'.
self assert: 295 printStringRoman = 'CCXCV'.
self assert: 390 printStringRoman = 'CCCXC'.
self assert: 391 printStringRoman = 'CCCXCI'.
self assert: 392 printStringRoman = 'CCCXCII'.
self assert: 487 printStringRoman = 'CDLXXXVII'.
self assert: 488 printStringRoman = 'CDLXXXVIII'.
self assert: 489 printStringRoman = 'CDLXXXIX'.
self assert: 584 printStringRoman = 'DLXXXIV'.
self assert: 585 printStringRoman = 'DLXXXV'.
self assert: 586 printStringRoman = 'DLXXXVI'.
self assert: 681 printStringRoman = 'DCLXXXI'.
self assert: 682 printStringRoman = 'DCLXXXII'.
self assert: 683 printStringRoman = 'DCLXXXIII'.
self assert: 778 printStringRoman = 'DCCLXXVIII'.
self assert: 779 printStringRoman = 'DCCLXXIX'.
self assert: 780 printStringRoman = 'DCCLXXX'.
self assert: 875 printStringRoman = 'DCCCLXXV'.
self assert: 876 printStringRoman = 'DCCCLXXVI'.
self assert: 877 printStringRoman = 'DCCCLXXVII'.
self assert: 972 printStringRoman = 'CMLXXII'.
self assert: 973 printStringRoman = 'CMLXXIII'.
self assert: 974 printStringRoman = 'CMLXXIV'.
self assert: 1069 printStringRoman = 'MLXIX'.
self assert: 1070 printStringRoman = 'MLXX'.
self assert: 1071 printStringRoman = 'MLXXI'.
self assert: 1166 printStringRoman = 'MCLXVI'.
self assert: 1167 printStringRoman = 'MCLXVII'.
self assert: 1168 printStringRoman = 'MCLXVIII'.
self assert: 1263 printStringRoman = 'MCCLXIII'.
self assert: 1264 printStringRoman = 'MCCLXIV'.
self assert: 1265 printStringRoman = 'MCCLXV'.
self assert: 1360 printStringRoman = 'MCCCLX'.
self assert: 1361 printStringRoman = 'MCCCLXI'.
self assert: 1362 printStringRoman = 'MCCCLXII'.
self assert: 1457 printStringRoman = 'MCDLVII'.
self assert: 1458 printStringRoman = 'MCDLVIII'.
self assert: 1459 printStringRoman = 'MCDLIX'.
self assert: 1554 printStringRoman = 'MDLIV'.
self assert: 1555 printStringRoman = 'MDLV'.
self assert: 1556 printStringRoman = 'MDLVI'.
self assert: 1651 printStringRoman = 'MDCLI'.
self assert: 1652 printStringRoman = 'MDCLII'.
self assert: 1653 printStringRoman = 'MDCLIII'.
self assert: 1748 printStringRoman = 'MDCCXLVIII'.
self assert: 1749 printStringRoman = 'MDCCXLIX'.
self assert: 1750 printStringRoman = 'MDCCL'.
self assert: 1845 printStringRoman = 'MDCCCXLV'.
self assert: 1846 printStringRoman = 'MDCCCXLVI'.
self assert: 1847 printStringRoman = 'MDCCCXLVII'.
self assert: 1942 printStringRoman = 'MCMXLII'.
self assert: 1943 printStringRoman = 'MCMXLIII'.
self assert: 1944 printStringRoman = 'MCMXLIV'.
self assert: 2004 printStringRoman = 'MMIV'.
self assert: -1 printStringRoman = '-I'.
self assert: -2 printStringRoman = '-II'.
self assert: -3 printStringRoman = '-III'.
self assert: -4 printStringRoman = '-IV'.
self assert: -5 printStringRoman = '-V'.
self assert: -6 printStringRoman = '-VI'.
self assert: -7 printStringRoman = '-VII'.
self assert: -8 printStringRoman = '-VIII'.
self assert: -9 printStringRoman = '-IX'.
self assert: -10 printStringRoman = '-X'.
!
----- Method: IntegerTest>>testStringAsNumber (in category 'tests - instance creation') -----
testStringAsNumber
"This covers parsing in Number>>readFrom:
Trailing decimal points should be ignored."
self assert: ('123' asNumber == 123).
self assert: ('-123' asNumber == -123).
self assert: ('123.' asNumber == 123).
self assert: ('-123.' asNumber == -123).
self assert: ('123This is not to be read' asNumber == 123).
self assert: ('123s could be confused with a ScaledDecimal' asNumber == 123).
self assert: ('123e could be confused with a Float' asNumber == 123).
!
----- Method: IntegerTest>>testTwoComplementRightShift (in category 'tests - bitLogic') -----
testTwoComplementRightShift
"self run: #testTwoComplementRightShift"
| large small |
small := 2 << 16.
large := 2 << 32.
self assert: ((small negated bitShift: -1) ~= ((small + 1) negated bitShift: -1)
== ((large negated bitShift: -1) ~= ((large + 1) negated bitShift: -1))).
self assert: ((small bitShift: -1) ~= (small + 1 bitShift: -1)
== ((large bitShift: -1) ~= (large + 1 bitShift: -1))).!
TestCase subclass: #MethodContextTest
instanceVariableNames: 'aCompiledMethod aReceiver aMethodContext aSender'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!MethodContextTest commentStamp: 'tlk 5/31/2004 16:07' prior: 0!
I am an SUnit Test of MethodContext and its super type, ContextPart. See also BlockContextTest.
See pages 430-437 of A. Goldberg and D. Robson's Smalltalk-80 The Language (aka the purple book), which deal with Contexts. My fixtures are from their example. (The Squeak byte codes are not quite the same as Smalltalk-80.)
My fixtures are:
aReceiver - just some arbitrary object, "Rectangle origin: 100 at 100 corner: 200 at 200"
aSender - just some arbitrary object, thisContext
aCompiledMethod - just some arbitrary method, "Rectangle rightCenter".
aMethodContext - just some arbitray context ...
!
----- Method: MethodContextTest>>setUp (in category 'running') -----
setUp
super setUp.
aCompiledMethod := Rectangle methodDict at: #rightCenter.
aReceiver := 100 at 100 corner: 200 at 200.
aSender := thisContext.
aMethodContext := MethodContext sender: aSender receiver: aReceiver method: aCompiledMethod arguments: #(). !
----- Method: MethodContextTest>>testActivateReturnValue (in category 'tests') -----
testActivateReturnValue
self assert: ((aSender activateReturn: aMethodContext value: #()) isKindOf: MethodContext).
self assert: ((aSender activateReturn: aMethodContext value: #()) receiver = aMethodContext).!
----- Method: MethodContextTest>>testCopyStack (in category 'tests') -----
testCopyStack
self assert: aMethodContext copyStack printString = aMethodContext printString.!
----- Method: MethodContextTest>>testFindContextSuchThat (in category 'tests') -----
testFindContextSuchThat
self assert: (aMethodContext findContextSuchThat: [:each| true]) printString = aMethodContext printString.
self assert: (aMethodContext hasContext: aMethodContext). !
----- Method: MethodContextTest>>testMethodContext (in category 'tests') -----
testMethodContext
self deny: aMethodContext isPseudoContext.
self assert: aMethodContext home notNil.
self assert: aMethodContext receiver notNil.
self assert: (aMethodContext method isKindOf: CompiledMethod).!
----- Method: MethodContextTest>>testMethodIsBottomContext (in category 'tests') -----
testMethodIsBottomContext
self assert: aMethodContext bottomContext = aSender.
self assert: aMethodContext secondFromBottom = aMethodContext.!
----- Method: MethodContextTest>>testReturn (in category 'tests') -----
testReturn
"Why am I overriding setUp? Because sender must be thisContext, i.e, testReturn, not setUp."
aMethodContext := MethodContext sender: thisContext receiver: aReceiver method: aCompiledMethod arguments: #().
self assert: (aMethodContext return: 5) = 5.!
----- Method: MethodContextTest>>testSetUp (in category 'tests') -----
testSetUp
"Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
self assert: aMethodContext isMethodContext.
self deny: aMethodContext isBlockClosure.
self deny: aMethodContext isPseudoContext.
self deny: aMethodContext isDead.
"self assert: aMethodContext home = aReceiver."
"self assert: aMethodContext blockHome = aReceiver."
self assert: aMethodContext receiver = aReceiver.
self assert: (aMethodContext method isKindOf: CompiledMethod).
self assert: aMethodContext method = aCompiledMethod.
self assert: aMethodContext methodNode selector = #rightCenter.
self assert: (aMethodContext methodNodeFormattedAndDecorated: true) selector = #rightCenter.
self assert: aMethodContext client printString = 'MethodContextTest>>#testSetUp'.
!
----- Method: MethodContextTest>>testTempNamed (in category 'tests') -----
testTempNamed
| oneTemp |
oneTemp := 1.
self assert: (thisContext tempNamed: 'oneTemp') = oneTemp.
!
----- Method: MethodContextTest>>testTempNamedPut (in category 'tests') -----
testTempNamedPut
| oneTemp |
oneTemp := 1.
self assert: (thisContext tempNamed: 'oneTemp') = oneTemp.
thisContext tempNamed: 'oneTemp' put: 2.
self assert: (thisContext tempNamed: 'oneTemp') = 2.!
TestCase subclass: #MethodPragmaTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
----- Method: MethodPragmaTest>>assertPragma:givesKeyword:arguments: (in category 'utilities') -----
assertPragma: aString givesKeyword: aSymbol arguments: anArray
| pragma decompiled |
pragma := self pragma: aString selector: #zork.
self assert: pragma keyword = aSymbol.
self assert: pragma arguments = anArray.
decompiled := (self class>>#zork) decompile.
self assert: (decompiled properties pragmas includes: pragma).
self assert: (decompiled asString includesSubString: pragma asString).!
----- Method: MethodPragmaTest>>compile:selector: (in category 'utilities') -----
compile: aString selector: aSelector
self class
compileSilently: aSelector , String lf , aString
classified: self methodCategory.
^ self class >> aSelector.!
----- Method: MethodPragmaTest>>methodCategory (in category 'utilities') -----
methodCategory
^ #generated!
----- Method: MethodPragmaTest>>pragma:selector: (in category 'utilities') -----
pragma: aString selector: aSelector
^ (self compile: '<' , aString , '>' selector: aSelector)
pragmas first.!
----- Method: MethodPragmaTest>>pragma:selector:times: (in category 'utilities') -----
pragma: aSymbol selector: aSelector times: anInteger
^ (self
compile: (String streamContents: [ :stream |
(1 to: anInteger) asArray shuffled do: [ :each |
stream
nextPut: $<; nextPutAll: aSymbol; space;
print: each; nextPut: $>; cr ] ])
selector: aSelector)
pragmas.!
----- Method: MethodPragmaTest>>tearDown (in category 'running') -----
tearDown
(self class organization listAtCategoryNamed: self methodCategory)
do: [ :each | self class removeSelectorSilently: each ].
self class organization removeCategory: self methodCategory.!
----- Method: MethodPragmaTest>>testAllNamedFromTo (in category 'testing-finding') -----
testAllNamedFromTo
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma allNamed: #foo: from: self class to: Object.
self assert: pragmasDetected = pragmasCompiled.
pragmasDetected := Pragma allNamed: #foo: from: Object to: Object.
self assert: pragmasDetected isEmpty.!
----- Method: MethodPragmaTest>>testAllNamedFromToSortedByArgument (in category 'testing-finding') -----
testAllNamedFromToSortedByArgument
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma allNamed: #foo: from: self class to: Object sortedByArgument: 1.
self assert: pragmasDetected = (pragmasCompiled
sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])!
----- Method: MethodPragmaTest>>testAllNamedFromToSortedUsing (in category 'testing-finding') -----
testAllNamedFromToSortedUsing
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma
allNamed: #foo: from: self class to: Object
sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ].
self assert: pragmasDetected = (pragmasCompiled
sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).!
----- Method: MethodPragmaTest>>testAllNamedIn (in category 'testing-finding') -----
testAllNamedIn
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma allNamed: #foo: in: self class.
self assert: pragmasDetected = pragmasCompiled.
pragmasDetected := Pragma allNamed: #foo: in: Object.
self assert: pragmasDetected isEmpty.!
----- Method: MethodPragmaTest>>testAllNamedInSortedByArgument (in category 'testing-finding') -----
testAllNamedInSortedByArgument
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma allNamed: #foo: in: self class sortedByArgument: 1.
self assert: pragmasDetected = (pragmasCompiled
sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])!
----- Method: MethodPragmaTest>>testAllNamedInSortedUsing (in category 'testing-finding') -----
testAllNamedInSortedUsing
| pragmasCompiled pragmasDetected |
pragmasCompiled := self pragma: #foo: selector: #bar times: 5.
pragmasDetected := Pragma
allNamed: #foo: in: self class
sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ].
self assert: pragmasDetected = (pragmasCompiled
sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).!
----- Method: MethodPragmaTest>>testArguments (in category 'testing-pragma') -----
testArguments
| pragma |
pragma := Pragma keyword: #foo: arguments: #( 123 ).
self assert: pragma arguments = #( 123 ).!
----- Method: MethodPragmaTest>>testCompileArray (in category 'testing-compiler') -----
testCompileArray
self assertPragma: 'foo: #()' givesKeyword: #foo: arguments: #( () ).
self assertPragma: 'foo: #( foo )' givesKeyword: #foo: arguments: #( ( foo ) ).
self assertPragma: 'foo: #( foo: )' givesKeyword: #foo: arguments: #( ( foo: ) ).
self assertPragma: 'foo: #( 12 )' givesKeyword: #foo: arguments: #( ( 12 ) ).
self assertPragma: 'foo: #( true )' givesKeyword: #foo: arguments: #( ( true ) ).
!
----- Method: MethodPragmaTest>>testCompileBinary (in category 'testing-compiler') -----
testCompileBinary
self assertPragma: ' = 1' givesKeyword: #= arguments: #( 1 ).
self assertPragma: ' , 3' givesKeyword: #, arguments: #( 3 ).
self assertPragma: ' > 4' givesKeyword: #> arguments: #( 4 ).
self assertPragma: ' < 5' givesKeyword: #< arguments: #( 5 ).
self assertPragma: ' == 1' givesKeyword: #== arguments: #( 1 ).
self assertPragma: ' <> 3' givesKeyword: #<> arguments: #( 3 ).
self assertPragma: ' >< 4' givesKeyword: #>< arguments: #( 4 ).
self assertPragma: ' ** 5' givesKeyword: #** arguments: #( 5 )!
----- Method: MethodPragmaTest>>testCompileCharacter (in category 'testing-compiler') -----
testCompileCharacter
self assertPragma: 'foo: $a' givesKeyword: #foo: arguments: #( $a ).
self assertPragma: 'foo: $ ' givesKeyword: #foo: arguments: #( $ ).!
----- Method: MethodPragmaTest>>testCompileEmpty (in category 'testing-compiler') -----
testCompileEmpty
self assertPragma: 'foo' givesKeyword: #foo arguments: #().!
----- Method: MethodPragmaTest>>testCompileFull (in category 'testing-compiler') -----
testCompileFull
self assertPragma: 'foo: 1' givesKeyword: #foo: arguments: #( 1 ).
self assertPragma: 'foo: 1 bar: 2' givesKeyword: #foo:bar: arguments: #( 1 2 ).!
----- Method: MethodPragmaTest>>testCompileInvalid (in category 'testing-compiler') -----
testCompileInvalid
"Invalid pragmas should properly raise an error."
self should: [ self compile: '<>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<1>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<#123>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo bar>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo 1>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo bar zork>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo bar 1>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo: bar:>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo: #bar: zork:>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<<1>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<=2>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '< =1 = >' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '< =1 =2 >' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo: String>' selector: #zork ] raise: SyntaxErrorNotification.
self should: [ self compile: '<foo: Pragma>' selector: #zork ] raise: SyntaxErrorNotification!
----- Method: MethodPragmaTest>>testCompileNumber (in category 'testing-compiler') -----
testCompileNumber
self assertPragma: 'foo: 123' givesKeyword: #foo: arguments: #( 123 ).
self assertPragma: 'foo: -123' givesKeyword: #foo: arguments: #( -123 ).
self assertPragma: 'foo: 12.3' givesKeyword: #foo: arguments: #( 12.3 ).
self assertPragma: 'foo: -12.3' givesKeyword: #foo: arguments: #( -12.3 ).!
----- Method: MethodPragmaTest>>testCompileString (in category 'testing-compiler') -----
testCompileString
self assertPragma: 'foo: ''''' givesKeyword: #foo: arguments: #( '' ).
self assertPragma: 'foo: ''bar''' givesKeyword: #foo: arguments: #( 'bar' ).!
----- Method: MethodPragmaTest>>testCompileSymbol (in category 'testing-compiler') -----
testCompileSymbol
self assertPragma: 'foo: #bar' givesKeyword: #foo: arguments: #( bar ).
self assertPragma: 'foo: #bar:' givesKeyword: #foo: arguments: #( bar: ).
self assertPragma: 'foo: #bar:zork:' givesKeyword: #foo: arguments: #( bar:zork: ).!
----- Method: MethodPragmaTest>>testCompileTemps (in category 'testing-compiler') -----
testCompileTemps
"Pragmas should be placeable before and after temps."
self
shouldnt: [
self assert: (self compile: '| temps | <foo>' selector: #zork)
pragmas notEmpty ]
raise: SyntaxErrorNotification.
self
shouldnt: [
self assert: (self compile: '<foo> | temps |' selector: #zork)
pragmas notEmpty ]
raise: SyntaxErrorNotification.!
----- Method: MethodPragmaTest>>testCompileValue (in category 'testing-compiler') -----
testCompileValue
self assertPragma: 'foo: true' givesKeyword: #foo: arguments: #( true ).
self assertPragma: 'foo: false' givesKeyword: #foo: arguments: #( false ).
self assertPragma: 'foo: nil' givesKeyword: #foo: arguments: #( nil )!
----- Method: MethodPragmaTest>>testKeyword (in category 'testing-pragma') -----
testKeyword
| pragma |
pragma := Pragma keyword: #foo: arguments: #( 123 ).
self assert: pragma keyword = #foo:.!
----- Method: MethodPragmaTest>>testMessage (in category 'testing-pragma') -----
testMessage
| pragma message |
pragma := Pragma keyword: #foo: arguments: #( 123 ).
message := pragma message.
self assert: message selector = #foo:.
self assert: message arguments = #( 123 ).!
----- Method: MethodPragmaTest>>testMethod (in category 'testing-method') -----
testMethod
| pragma |
pragma := self pragma: 'foo' selector: #bar.
self assert: pragma method == (self class >> #bar).!
----- Method: MethodPragmaTest>>testMethodClass (in category 'testing-method') -----
testMethodClass
| pragma |
pragma := self pragma: 'foo' selector: #bar.
self assert: pragma methodClass == self class.!
----- Method: MethodPragmaTest>>testNoPragma (in category 'testing-compiled') -----
testNoPragma
| method |
method := self compile: '' selector: #foo.
self assert: method pragmas = #().!
----- Method: MethodPragmaTest>>testPrimitiveIndexed1 (in category 'testing-primitives') -----
testPrimitiveIndexed1
"This test useses the #instVarAt: primitive."
self compile: '<primitive: 74> ^ #inst' selector: #inst.
self assert: self inst = #inst.!
----- Method: MethodPragmaTest>>testPrimitiveIndexed2 (in category 'testing-primitives') -----
testPrimitiveIndexed2
"This test useses the #asOop primitive."
self compile: '<primitive: 75> ^ #oop' selector: #oop.
self assert: self oop = self asOop.!
----- Method: MethodPragmaTest>>testPrimitiveNamed1 (in category 'testing-primitives') -----
testPrimitiveNamed1
"This test useses the #primitiveDirectoryLookup primitive."
self compile: '<primitive: ''primitiveDirectoryLookup'' module: ''FilePlugin''> ^ #lookup' selector: #lookup.
self assert: self lookup = #lookup.
!
----- Method: MethodPragmaTest>>testPrimitiveNamed2 (in category 'testing-primitives') -----
testPrimitiveNamed2
"This test useses the #primPathNameDelimiter primitive."
self compile: '<primitive: ''primitiveDirectoryDelimitor'' module: ''FilePlugin''> ^ #delim' selector: #delim.
self assert: self delim = FileDirectory primPathNameDelimiter.
!
----- Method: MethodPragmaTest>>testReformat (in category 'testing-printing-reformating') -----
testReformat
self assert: (DisplayScreen class compiledMethodAt: #actualScreenDepth) getSource string = 'actualScreenDepth
<primitive: ''primitiveScreenDepth''>
^ Display depth'.
self shouldnt: [ DisplayScreen class reformatMethodAt: #actualScreenDepth] raise: Error.
self assert: (DisplayScreen class compiledMethodAt: #actualScreenDepth) getSource string = 'actualScreenDepth
<primitive: ''primitiveScreenDepth''>
^ Display depth'.
!
----- Method: MethodPragmaTest>>testSelector (in category 'testing-method') -----
testSelector
| pragma |
pragma := self pragma: 'foo' selector: #bar.
self assert: pragma selector == #bar.!
TestCase subclass: #MethodPropertiesTest
instanceVariableNames: 'method'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
----- Method: MethodPropertiesTest>>propertyDictionaryFor: (in category 'private') -----
propertyDictionaryFor: aMethod
^ aMethod properties instVarNamed: 'properties'.!
----- Method: MethodPropertiesTest>>setUp (in category 'running') -----
setUp
method := Object >> #halt.!
----- Method: MethodPropertiesTest>>tearDown (in category 'running') -----
tearDown
Object recompile: #halt from: Object.!
----- Method: MethodPropertiesTest>>testAllMethodsHaveMethodClass (in category 'testing') -----
testAllMethodsHaveMethodClass
Smalltalk garbageCollect.
self assert: (CompiledMethod allInstances
reject: [:cm | cm literals last isVariableBinding
and: [cm literals last value isBehavior
or: [cm literals last value isTrait]]]) isEmpty
description: 'CompiledMethods must have methodClass literal'!
----- Method: MethodPropertiesTest>>testAllMethodsHaveNewPropertyFormat (in category 'testing') -----
testAllMethodsHaveNewPropertyFormat
Smalltalk garbageCollect.
self assert: (CompiledMethod allInstances
reject: [:cm | cm hasNewPropertyFormat]) isEmpty
description: 'CompiledMethods must have new property format'!
----- Method: MethodPropertiesTest>>testAt (in category 'testing') -----
testAt
self should: [ method properties at: #zork ] raise: Error.
self assert: (self propertyDictionaryFor: method) isNil.
method properties at: #zork put: 'hello'.
self assert: (method properties at: #zork) = 'hello'.!
----- Method: MethodPropertiesTest>>testAtIfAbsent (in category 'testing') -----
testAtIfAbsent
self assert: (method properties at: #zork ifAbsent: [ 'hello' ]) = 'hello'.
self assert: (self propertyDictionaryFor: method) isNil.
method properties at: #zork put: 'hi'.
self assert: (method properties at: #zork ifAbsent: [ 'hello' ]) = 'hi'.!
----- Method: MethodPropertiesTest>>testAtIfAbsentPut (in category 'testing') -----
testAtIfAbsentPut
self assert: (method properties at: #zork ifAbsentPut: [ 'hello' ]) = 'hello'.
self assert: (method properties at: #zork ifAbsentPut: [ 'hi' ]) = 'hello'.!
----- Method: MethodPropertiesTest>>testAtPut (in category 'testing') -----
testAtPut
self assert: (method properties at: #zork put: 'hello') = 'hello'.
self assert: (method properties at: #zork) = 'hello'.!
----- Method: MethodPropertiesTest>>testIncludesKey (in category 'testing') -----
testIncludesKey
self deny: (method properties includesKey: #zork).
self assert: (self propertyDictionaryFor: method) isNil.
method properties at: #zork put: 123.
self assert: (method properties includesKey: #zork).!
----- Method: MethodPropertiesTest>>testRemoveKey (in category 'testing') -----
testRemoveKey
method properties at: #zork put: 'hello'.
self should: [ method properties removeKey: #halt ] raise: Error.
self assert: (method properties removeKey: #zork) = 'hello'.
self assert: (self propertyDictionaryFor: method) isNil.
self should: [ method properties removeKey: #zork ] raise: Error.
self assert: (self propertyDictionaryFor: method) isNil.!
----- Method: MethodPropertiesTest>>testRemoveKeyifAbsent (in category 'testing') -----
testRemoveKeyifAbsent
method properties at: #zork put: 'hello'.
self assert: (method properties removeKey: #halt ifAbsent: [ 'hi' ]) = 'hi'.
self assert: (method properties removeKey: #zork ifAbsent: [ 'hi' ]) = 'hello'.
self assert: (self propertyDictionaryFor: method) isNil.
self should: (method properties removeKey: #zork ifAbsent: [ 'hi' ]) = 'hi'.
self assert: (self propertyDictionaryFor: method) isNil.!
TestCase subclass: #MonitorTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Processes'!
----- Method: MonitorTest>>testExample1 (in category 'examples') -----
testExample1
| producer1 producer2 monitor goal work counter goalReached finished |
goal := (1 to: 1000) asOrderedCollection.
work := OrderedCollection new.
counter := 0.
goalReached := false.
finished := Semaphore new.
monitor := Monitor new.
producer1 := [
[monitor critical:
[monitor waitUntil: [counter \\5 = 0].
goalReached or: [work add: (counter := counter + 1)].
goalReached := counter >= goal size.
monitor signal
].
goalReached
]
whileFalse.
finished signal.
].
producer2 := [
[monitor critical:
[monitor waitWhile: [counter \\5 = 0].
goalReached or: [work add: (counter := counter + 1)].
goalReached := counter >= goal size.
monitor signal].
goalReached
] whileFalse.
finished signal
].
producer1 forkAt: Processor userBackgroundPriority.
producer2 forkAt: Processor userBackgroundPriority.
finished wait; wait.
self assert: goal = work!
----- Method: MonitorTest>>testExample2 (in category 'examples') -----
testExample2
"Here is a second version that does not use a semaphore to inform the
forking process about termination of both forked processes"
| producer1 producer2 monitor goal work counter goalReached activeProducers|
goal := (1 to: 1000) asOrderedCollection.
work := OrderedCollection new.
counter := 0.
goalReached := false.
activeProducers := 0.
monitor := Monitor new.
producer1 :=
[ monitor critical: [activeProducers := activeProducers + 1].
[monitor critical:
[monitor waitUntil: [counter \\5 = 0].
goalReached or: [work add: (counter := counter + 1)].
" Transcript show: 'P1 '; show: counter printString; show: ' ';
show: activeProducers printString; cr."
goalReached := counter >= goal size.
monitor signal
].
goalReached
]
whileFalse.
monitor critical: [activeProducers := activeProducers - 1.
monitor signal: #finish].
] .
producer2 :=
[monitor critical: [activeProducers := activeProducers + 1].
[monitor critical:
[monitor waitWhile: [counter \\5 = 0].
goalReached or: [work add: (counter := counter + 1)].
goalReached := counter >= goal size.
monitor signal].
goalReached ] whileFalse.
monitor critical: [
activeProducers := activeProducers - 1.
monitor signal: #finish].
].
producer1 forkAt: Processor userBackgroundPriority.
producer2 forkAt: Processor userBackgroundPriority.
monitor critical: [
monitor waitUntil: [activeProducers = 0 & (goalReached)]
for: #finish.
].
self assert: goal = work
!
TestCase subclass: #NumberParsingTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
!NumberParsingTest commentStamp: 'dtl 11/24/2004 15:35' prior: 0!
Tests to verify parsing of numbers from streams and strings.
Note: ScaledDecimalTest contains related tests for parsing ScaledDecimal.!
----- Method: NumberParsingTest>>testFloatFromStreamAsNumber (in category 'tests - Float') -----
testFloatFromStreamAsNumber
"This covers parsing in Number>>readFrom:"
| rs aFloat |
rs := '10r-12.3456' readStream.
aFloat := Number readFrom: rs.
self assert: -12.3456 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456e2' readStream.
aFloat := Number readFrom: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456e2e2' readStream.
aFloat := Number readFrom: rs.
self assert: -1234.56 = aFloat.
self assert: rs upToEnd = 'e2'.
rs := '10r-12.3456d2' readStream.
aFloat := Number readFrom: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456q2' readStream.
aFloat := Number readFrom: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '-12.3456q2' readStream.
aFloat := Number readFrom: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '12.3456q2' readStream.
aFloat := Number readFrom: rs.
self assert: 1234.56 = aFloat.
self assert: rs atEnd.
rs := '12.3456z2' readStream.
aFloat := Number readFrom: rs.
self assert: 12.3456 = aFloat.
self assert: rs upToEnd = 'z2'.
!
----- Method: NumberParsingTest>>testFloatFromStreamWithExponent (in category 'tests - Float') -----
testFloatFromStreamWithExponent
"This covers parsing in Number>>readFrom:"
| rs aFloat |
rs := '1.0e-14' readStream.
aFloat := Number readFrom: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs atEnd.
rs := '1.0e-14 1' readStream.
aFloat := Number readFrom: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs upToEnd = ' 1'.
rs := '1.0e-14eee' readStream.
aFloat := Number readFrom: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs upToEnd = 'eee'.
rs := '1.0e14e10' readStream.
aFloat := Number readFrom: rs.
self assert: 1.0e14 = aFloat.
self assert: rs upToEnd = 'e10'.
rs := '1.0e+14e' readStream. "Plus sign is not parseable"
aFloat := Number readFrom: rs.
self assert: 1.0 = aFloat.
self assert: rs upToEnd = 'e+14e'.
rs := '1.0e' readStream.
aFloat := Number readFrom: rs.
self assert: 1.0 = aFloat.
self assert: rs upToEnd = 'e'.!
----- Method: NumberParsingTest>>testFloatFromStringAsNumber (in category 'tests - Float') -----
testFloatFromStringAsNumber
"This covers parsing in Number>>readFrom:"
| aFloat |
aFloat := '10r-12.3456' asNumber.
self assert: -12.3456 = aFloat.
aFloat := '10r-12.3456e2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '10r-12.3456d2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '10r-12.3456q2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '-12.3456q2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '12.3456q2' asNumber.
self assert: 1234.56 = aFloat.
!
----- Method: NumberParsingTest>>testFloatFromStringWithExponent (in category 'tests - Float') -----
testFloatFromStringWithExponent
"This covers parsing in Number>>readFrom:"
| aFloat |
aFloat := '1.0e-14' asNumber.
self assert: 1.0e-14 = aFloat.
aFloat := '1.0e-14 1' asNumber.
self assert: 1.0e-14 = aFloat.
aFloat := '1.0e-14e' asNumber.
self assert: 1.0e-14 = aFloat.
aFloat := '1.0e14e' asNumber.
self assert: 1.0e14 = aFloat.
aFloat := '1.0e+14e' asNumber. "Plus sign is not parseable"
self assert: 1.0 = aFloat.
!
----- Method: NumberParsingTest>>testFloatReadWithRadix (in category 'tests - Float') -----
testFloatReadWithRadix
"This covers parsing in Number>>readFrom:
Note: In most Smalltalk dialects, the radix notation is not used for numbers
with exponents. In Squeak, a string with radix and exponent can be parsed,
and the exponent is always treated as base 10 (not the base indicated in the
radix prefix). I am not sure if this is a feature, a bug, or both, but the
Squeak behavior is documented in this test. -dtl"
| aNumber rs |
aNumber := '2r1.0101e9' asNumber.
self assert: 672.0 = aNumber.
self assert: (Number readFrom: '2r1.0101e9') = (1.3125 * (2 raisedTo: 9)).
rs := '2r1.0101e9e9' readStream.
self assert: (Number readFrom: rs) = 672.0.
self assert: rs upToEnd = 'e9'!
----- Method: NumberParsingTest>>testIntegerFromString (in category 'tests - Integer') -----
testIntegerFromString
"This covers parsing in Number>>readFrom:
Trailing decimal points should be ignored."
self assert: ('123' asNumber == 123).
self assert: ('-123' asNumber == -123).
self assert: ('123.' asNumber == 123).
self assert: ('-123.' asNumber == -123).
self assert: ('123This is not to be read' asNumber == 123).
self assert: ('123s could be confused with a ScaledDecimal' asNumber == 123).
self assert: ('123e could be confused with a Float' asNumber == 123).
!
----- Method: NumberParsingTest>>testIntegerReadFrom (in category 'tests - Integer') -----
testIntegerReadFrom
"Ensure remaining characters in a stream are not lost when parsing an integer."
| rs i s |
rs := '123s could be confused with a ScaledDecimal' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: 's could be confused with a ScaledDecimal' = s.
rs := '123.s could be confused with a ScaledDecimal' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: '.s could be confused with a ScaledDecimal' = s.
rs := '123sA has unary message sA' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: 'sA has unary message sA' = s.
rs := '123sB has unary message sB' readStream.
i := Number readFrom: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: 'sB has unary message sB' = s!
----- Method: NumberParsingTest>>testIntegerReadWithRadix (in category 'tests - Integer') -----
testIntegerReadWithRadix
"This covers parsing in Number>>readFrom:
Note: In most Smalltalk dialects, the radix notation is not used for numbers
with exponents. In Squeak, a string with radix and exponent can be parsed,
and the exponent is always treated as base 10 (not the base indicated in the
radix prefix). I am not sure if this is a feature, a bug, or both, but the
Squeak behavior is documented in this test. -dtl"
| aNumber rs |
aNumber := '2r1e26' asNumber.
self assert: 67108864 = aNumber.
self assert: (Number readFrom: '2r1e26') = (2 raisedTo: 26).
rs := '2r1e26eee' readStream.
self assert: (Number readFrom: rs) = 67108864.
self assert: rs upToEnd = 'eee'
!
----- Method: NumberParsingTest>>testNumberReadExactlyError (in category 'tests - Float') -----
testNumberReadExactlyError
"This covers parsing in Number>>readExactlyFrom:"
| rs |
rs := '' readStream.
self should: [Number readExactlyFrom: rs] raise: Error.
rs := 'foo' readStream.
self should: [Number readExactlyFrom: rs] raise: Error.
rs := 'radix' readStream.
self should: [Number readFrom: rs] raise: Error.
rs := '.e0' readStream.
self should: [Number readExactlyFrom: rs] raise: Error.
rs := '-.e0' readStream.
self should: [Number readExactlyFrom: rs] raise: Error.
rs := '--1' readStream.
self should: [Number readExactlyFrom: rs] raise: Error.!
----- Method: NumberParsingTest>>testNumberReadOnlyDigit (in category 'tests - Float') -----
testNumberReadOnlyDigit
"This covers parsing in Number>>readFrom:"
| rs num |
rs := '1e' readStream.
num := Number readFrom: rs.
self assert: 1 = num.
self assert: rs upToEnd = 'e'.
rs := '1s' readStream.
num := Number readFrom: rs.
self assert: 1 = num.
self assert: rs upToEnd = 's'.
rs := '1.' readStream.
num := Number readFrom: rs.
self assert: 1 = num.
self assert: num isInteger.
self assert: rs upToEnd = '.'.!
TestCase subclass: #SelfEvaluatingObjectTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
----- Method: SelfEvaluatingObjectTest>>assertCode:print: (in category 'utilities') -----
assertCode: code print: aString
self assert: (self compile: code) printString = aString!
----- Method: SelfEvaluatingObjectTest>>compile: (in category 'utilities') -----
compile: aString
^ Compiler evaluate: aString!
----- Method: SelfEvaluatingObjectTest>>testArray (in category 'tests') -----
testArray
"self run: #testArray"
self assertCode: '#(1 2 3)' print: '#(1 2 3)'.
self assertCode: '{1 . 2 . 3}' print: '#(1 2 3)'.
self assertCode: '{1 + 0 . 2 . 3}' print: '#(1 2 3)'.
self assertCode: '{1 + 0 . 1 @ 2 . 3}' print: '{1 . 1 at 2 . 3}'.
self assertCode: '{2 at 3}' print: '{2 at 3}'.
self assertCode: '{Object new}' print: 'an Array(an Object)'.
self assertCode: '{Rectangle new . Object new}' print: 'an Array(nil corner: nil an Object)'.
self assertCode: '{10 at 10 corner: 20 at 20 . 100 at 100 corner: 200 at 200}' print: '{10 at 10 corner: 20 at 20 . 100 at 100 corner: 200 at 200}'!
----- Method: SelfEvaluatingObjectTest>>testObjects (in category 'tests') -----
testObjects
"self debug: #testObjects"
self assert: 10 isSelfEvaluating.
self assert: $a isSelfEvaluating.
self assert: 3.14157 isSelfEvaluating.
self assert: #(1 2 3) isSelfEvaluating.
self assert: #abc isSelfEvaluating.
self assert: 'abc' isSelfEvaluating.
self assert: Object isSelfEvaluating.
self assert: Object new isSelfEvaluating not.
self assert: (Array with: 10) isSelfEvaluating.
self assert: (Array with: Object new) isSelfEvaluating not.
self assert: true isSelfEvaluating.
self assert: false isSelfEvaluating.
self assert: nil isSelfEvaluating.
self assert: (1 to: 10) isSelfEvaluating.
self assert: (1->2) isSelfEvaluating.
self assert: Color red isSelfEvaluating.
self assert: RunArray new isSelfEvaluating.!
TestCase subclass: #TimespanDoSpanAYearTest
instanceVariableNames: 'aTimespan aDuration aDate'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!TimespanDoSpanAYearTest commentStamp: 'tlk 1/6/2004 17:55' prior: 0!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndTimeEpochTestCase for a complete list. tlk.
My fixtures include a Timespan that crosses over a year boundary:
aDate = December 25, 2004, midnight
aDuration = 91 days
aTimeSpan= 91 days, starting December 25, 2004, midnight!
----- Method: TimespanDoSpanAYearTest>>setUp (in category 'running') -----
setUp
aDate := DateAndTime year: 2004 month: 12 day: 25 hour: 0 minute: 0 second: 0.
aDuration := Duration days: 91 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.
aTimespan := Timespan starting: aDate duration: aDuration!
----- Method: TimespanDoSpanAYearTest>>testMonthsDo (in category 'testing') -----
testMonthsDo
| monthArray |
monthArray := Array
with: (Month starting: (DateAndTime year: 2004 day: 355) duration: 31 days)
with: (Month starting: (DateAndTime year: 2005 day: 1) duration: 31 days)
with: (Month starting: (DateAndTime year: 2005 day: 32) duration: 29 days)
with: (Month starting: (DateAndTime year: 2005 day: 61) duration: 31 days).
self assert: aTimespan months = monthArray!
----- Method: TimespanDoSpanAYearTest>>testNext (in category 'testing') -----
testNext
self assert: aTimespan next
= (Timespan
starting: (DateAndTime
year: 2005
month: 3
day: 26
hour: 0
minute: 0
second: 0)
duration: aDuration)!
----- Method: TimespanDoSpanAYearTest>>testWeeksDo (in category 'testing') -----
testWeeksDo
| weeks weekArray |
weeks := aTimespan weeks.
self assert: weeks size = ((aDuration days / 7.0) ceiling + 1).
weekArray := OrderedCollection new.
weekArray
addLast: (Week starting: (DateAndTime year: 2004 month: 12 day: 19) duration: 7 days);
addLast: (Week starting: (DateAndTime year: 2004 month: 12 day: 26) duration: 7 days).
2 to: 79 by: 7 do:
[ :i | weekArray
addLast: (Week starting: (DateAndTime year: 2005 day: i) duration: 7 days) ].
weekArray := weekArray asArray.
self assert: aTimespan weeks = weekArray
!
----- Method: TimespanDoSpanAYearTest>>testYearsDo (in category 'testing') -----
testYearsDo
| yearArray |
yearArray := Array
with: (Year
starting: (DateAndTime
year: 2004
month: 12
day: 25)
duration: 366 days).
self assert: aTimespan years = yearArray
!
TestCase subclass: #TimespanDoTest
instanceVariableNames: 'aTimespan aDuration aDate'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!TimespanDoTest commentStamp: 'tlk 1/6/2004 17:55' prior: 0!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndTimeEpochTestCase for a complete list. tlk.
My fixtures are:
aDate = January 8, 2003, midnight
aDuration = 91 days
aTimeSpan= 91 days, starting January 8, 2003, midnight
!
----- Method: TimespanDoTest>>setUp (in category 'running') -----
setUp
aDate := DateAndTime
year: 2003
month: 01
day: 07
hour: 0
minute: 0
second: 0.
aDuration := Duration
days: 91
hours: 0
minutes: 0
seconds: 0
nanoSeconds: 0.
aTimespan := Timespan starting: aDate duration: aDuration!
----- Method: TimespanDoTest>>testDatesDo (in category 'testing') -----
testDatesDo
| dateArray |
dateArray := OrderedCollection new.
7
to: 97
do: [:each | dateArray
addLast: (Date year: 2003 day: each)].
dateArray := dateArray asArray.
self assert: aTimespan dates = dateArray!
----- Method: TimespanDoTest>>testDoWith (in category 'testing') -----
testDoWith
| count |
count := 0.
aTimespan
do: [:each | count := count + 1]
with: (Timespan
starting: aDate
duration: 7 days).
self assert: count = 13!
----- Method: TimespanDoTest>>testDoWithWhen (in category 'testing') -----
testDoWithWhen
| count |
count := 0.
aTimespan
do: [:each | count := count + 1]
with: (Timespan starting: aDate duration: 7 days)
when: [:each | count < 5].
self assert: count = 5
!
----- Method: TimespanDoTest>>testEveryDo (in category 'testing') -----
testEveryDo
|count duration |
count := 0.
duration := 7 days.
(aTimespan
every: duration
do: [:each | count := count + 1]).
self assert: count = 13
!
----- Method: TimespanDoTest>>testMonthsDo (in category 'testing') -----
testMonthsDo
| monthArray |
monthArray := Array
with: (Month
starting: (DateAndTime year: 2003 day: 1)
duration: 31 days)
with: (Month
starting: (DateAndTime year: 2003 day: 32)
duration: 28 days)
with: (Month
starting: (DateAndTime year: 2003 day: 60)
duration: 31 days)
with: (Month
starting: (DateAndTime year: 2003 day: 91)
duration: 30 days).
self assert: aTimespan months = monthArray!
----- Method: TimespanDoTest>>testNext (in category 'testing') -----
testNext
self assert: aTimespan next
= (Timespan
starting: (DateAndTime
year: 2003
month: 4
day: 8
hour: 0
minute: 0
second: 0)
duration: aDuration)!
----- Method: TimespanDoTest>>testWeeksDo (in category 'testing') -----
testWeeksDo
| weekArray |
weekArray := OrderedCollection new.
7
to: 98
by: 7
do: [:each | weekArray
addLast: (Week
starting: (DateAndTime year: 2003 day: each)
duration: 7 days)].
weekArray := weekArray asArray.
self assert: aTimespan weeks = weekArray
!
----- Method: TimespanDoTest>>testYearsDo (in category 'testing') -----
testYearsDo
| yearArray |
yearArray := Array
with: (Year
starting: (DateAndTime year: 2003 day: 7)
duration: 365 days).
self assert: aTimespan years contents = yearArray contents!
TestCase subclass: #YearMonthWeekTest
instanceVariableNames: 'restoredStartDay restoredTimeZone'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!YearMonthWeekTest commentStamp: 'tlk 1/6/2004 17:55' prior: 0!
I am one of several Sunit test Cases intentended to provide complete coverage for the Chronology set of classes as part of the external testing. See DateAndEpochTestCase for a complete list. tlk.
I have no fixtures but do make sure to restore anything I change.!
----- Method: YearMonthWeekTest>>setUp (in category 'running') -----
setUp
restoredStartDay := Week startDay.
restoredTimeZone := DateAndTime localTimeZone.
Week startDay: #Sunday.
DateAndTime localTimeZone: (TimeZone timeZones detect: [:tz | tz abbreviation = 'GMT']).!
----- Method: YearMonthWeekTest>>tearDown (in category 'running') -----
tearDown
Week startDay: restoredStartDay.
DateAndTime localTimeZone: restoredTimeZone.!
----- Method: YearMonthWeekTest>>testDaysInMonth (in category 'testing') -----
testDaysInMonth
self assert: (Month daysInMonth: 2 forYear: 2000) = 29.
self assert: (Month daysInMonth: 2 forYear: 2001) = 28.
self assert: (Month daysInMonth: 2 forYear: 2004) = 29.
self assert: (Month daysInMonth: 2 forYear: 2100) = 28.
self assert: (Month daysInMonth: 'January' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'February' forYear: 2003) = 28.
self assert: (Month daysInMonth: 'March' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'April' forYear: 2003) = 30.
self assert: (Month daysInMonth: 'May' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'June' forYear: 2003) = 30.
self assert: (Month daysInMonth: 'July' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'August' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'September' forYear: 2003) = 30.
self assert: (Month daysInMonth: 'October' forYear: 2003) = 31.
self assert: (Month daysInMonth: 'November' forYear: 2003) = 30.
self assert: (Month daysInMonth: 'December' forYear: 2003) = 31.!
----- Method: YearMonthWeekTest>>testDaysInYear (in category 'testing') -----
testDaysInYear
self assert: (Year daysInYear: 2000) = 366.
self assert: (Year daysInYear: 2001) = 365.
self assert: (Year daysInYear: 2004) = 366.
self assert: (Year daysInYear: 2100) = 365.
self assert: (Year daysInYear: 2003) = 365.!
----- Method: YearMonthWeekTest>>testIndexOfDay (in category 'testing') -----
testIndexOfDay
self assert: (Week indexOfDay: 'Friday') = 6.
!
----- Method: YearMonthWeekTest>>testIsLeapYear (in category 'testing') -----
testIsLeapYear
self assert: (Year isLeapYear: 2000).
self deny: (Year isLeapYear: 2001).
self assert: (Year isLeapYear: 2004).
self deny: (Year isLeapYear: 2100).
self deny: (Year isLeapYear: 2002).!
----- Method: YearMonthWeekTest>>testMonthPrintOn (in category 'testing') -----
testMonthPrintOn
| aMonth cs rw |
aMonth := Month
starting: DateAndTime new
duration: 31 days.
cs := 'January 1901' readStream.
rw := ReadWriteStream on: ''.
aMonth printOn: rw.
self assert: rw contents = cs contents!
----- Method: YearMonthWeekTest>>testStartDay (in category 'testing') -----
testStartDay
Week startDay: 'Wednesday'.
self assert: Week startDay = 'Wednesday'.
Week startDay: 'Thursday'.
self assert: Week startDay = 'Thursday'.
!
----- Method: YearMonthWeekTest>>testWeekPrintOn (in category 'testing') -----
testWeekPrintOn
| aWeek cs rw |
aWeek := Week starting: (DateAndTime year: 1900 month: 12 day: 31).
cs := 'a Week starting: 1900-12-30T00:00:00+00:00'.
rw := WriteStream on: ''.
aWeek printOn: rw.
self assert: rw contents = cs!
----- Method: YearMonthWeekTest>>testYearPrintOn (in category 'testing') -----
testYearPrintOn
| aYear cs rw |
aYear := Year
starting: DateAndTime new
duration: 365 days.
cs := 'a Year (1901)' readStream.
rw := ReadWriteStream on: ''.
aYear printOn: rw.
self assert: rw contents = cs contents!
ClassTestCase subclass: #BooleanTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
!BooleanTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Boolean. 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
!
----- Method: BooleanTest>>testBasicType (in category 'tests') -----
testBasicType
self assert: (true basicType = #Boolean).
self assert: (false basicType = #Boolean).!
----- Method: BooleanTest>>testBooleanInitializedInstance (in category 'tests') -----
testBooleanInitializedInstance
self assert: (Boolean initializedInstance = nil).!
----- Method: BooleanTest>>testBooleanNew (in category 'tests') -----
testBooleanNew
self should: [Boolean new] raise: TestResult error.
self should: [True new] raise: TestResult error.
self should: [False new] raise: TestResult error. !
----- Method: BooleanTest>>testNew (in category 'tests') -----
testNew
self should: [Boolean new] raise: TestResult error. !
----- Method: BooleanTest>>testNewTileMorphRepresentative (in category 'tests') -----
testNewTileMorphRepresentative
self assert: (false newTileMorphRepresentative isKindOf: TileMorph).
self assert: (false newTileMorphRepresentative literal = false).
self assert: (true newTileMorphRepresentative literal = true).!
ClassTestCase subclass: #ClassDescriptionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Classes'!
!ClassDescriptionTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class ClassDescription. 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!
----- Method: ClassDescriptionTest>>testMethods (in category 'tests') -----
testMethods
self assert: Object methods = Object methodDict values. !
----- Method: ClassDescriptionTest>>testOrganization (in category 'tests') -----
testOrganization
| aClassOrganizer |
aClassOrganizer := ClassDescription organization.
self assert: (aClassOrganizer isKindOf: ClassOrganizer).!
ClassTestCase subclass: #CompiledMethodTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!CompiledMethodTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class CompiledMethod. 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!
----- Method: CompiledMethodTest>>returnPlusOne: (in category 'examples') -----
returnPlusOne: anInteger
^anInteger + 1. !
----- Method: CompiledMethodTest>>returnTrue (in category 'examples') -----
returnTrue
^true !
----- Method: CompiledMethodTest>>testDecompile (in category 'tests - decompiling') -----
testDecompile
"self debug: #testDecompileTree"
| method cls stream |
Smalltalk removeClassNamed: #TUTU.
cls := Object subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
stream := ReadWriteStream on: String new.
method decompile printOn: stream.
self assert: stream contents = 'foo
^ 10'
!
----- Method: CompiledMethodTest>>testHasNewPropertyFormat (in category 'tests - testing') -----
testHasNewPropertyFormat
| method |
method := (self class)>>#returnTrue.
self assert: method hasNewPropertyFormat.
!
----- Method: CompiledMethodTest>>testIsInstalled (in category 'tests - testing') -----
testIsInstalled
| method cls |
method := (self class)>>#returnTrue.
self assert: method isInstalled.
"now make an orphaned method by just deleting the class."
Smalltalk removeClassNamed: #TUTU.
cls := Object subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
self deny: method isInstalled. !
----- Method: CompiledMethodTest>>testIsQuick (in category 'tests - testing') -----
testIsQuick
| method |
method := self class compiledMethodAt: #returnTrue.
self assert: (method isQuick).
method := self class compiledMethodAt: #returnPlusOne:.
self deny: (method isQuick).
!
----- Method: CompiledMethodTest>>testMethodClass (in category 'tests - accessing') -----
testMethodClass
| method cls |
method := self class >> #returnTrue.
self assert: method selector = #returnTrue.
"now make an orphaned method by just deleting the class.
old: #unknown
new semantics: return Absolete class"
Smalltalk removeClassNamed: #TUTU.
cls := Object
subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
self assert: method methodClass = cls!
----- Method: CompiledMethodTest>>testSearchForClass (in category 'tests - accessing') -----
testSearchForClass
| method cls |
method := (self class)>>#returnTrue.
self assert: (method searchForClass = self class).
"now make an orphaned method. we want to get nil as the class"
Smalltalk removeClassNamed: #TUTU.
cls := Object subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
self assert: method searchForClass = nil.
!
----- Method: CompiledMethodTest>>testSearchForSelector (in category 'tests - accessing') -----
testSearchForSelector
| method cls |
method := (self class)>>#returnTrue.
self assert: (method searchForSelector = #returnTrue).
"now make an orphaned method. we want to get nil as the selector"
Smalltalk removeClassNamed: #TUTU.
cls := Object subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
self assert: method searchForSelector = nil.
!
----- Method: CompiledMethodTest>>testSelector (in category 'tests - accessing') -----
testSelector
| method cls |
method := (self class)>>#returnTrue.
self assert: (method selector = #returnTrue).
"now make an orphaned method. new semantics: return corrent name"
Smalltalk removeClassNamed: #TUTU.
cls := Object subclass: #TUTU
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'.
cls compile: 'foo ^ 10'.
method := cls >> #foo.
Smalltalk removeClassNamed: #TUTU.
self assert: method selector = #foo.
!
----- Method: CompiledMethodTest>>testValueWithReceiverArguments (in category 'tests - evaluating') -----
testValueWithReceiverArguments
| method value |
method := self class compiledMethodAt: #returnTrue.
value := method valueWithReceiver: nil arguments: #().
self assert: (value = true).
method := self class compiledMethodAt: #returnPlusOne:.
value := method valueWithReceiver: nil arguments: #(1).
self assert: (value = 2). !
ClassTestCase subclass: #DateAndTimeTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: DateAndTimeTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ DateAndTime
!
----- Method: DateAndTimeTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| private |
private := #( #printOn: ).
^ super selectorsToBeIgnored, private
!
----- Method: DateAndTimeTest>>testArithmeticAcrossDateBoundary (in category 'Tests') -----
testArithmeticAcrossDateBoundary
| t1 t2 |
t1 := '2004-01-07T11:55:00+00:00' asDateAndTime.
t2 := t1 - ( (42900+1) seconds).
self
assert: t2 = ('2004-01-06T23:59:59+00:00' asDateAndTime)
!
----- Method: DateAndTimeTest>>testDateTimeDenotation1 (in category 'Tests') -----
testDateTimeDenotation1
"DateAndTimeTest new testDateTimeDenotation1"
" Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests the correct interpretation of the DateAndTime denotation. "
| twoPmInLondon twoPmUTCInLocalTimeOfDetroit nineAmInDetroit |
twoPmInLondon := DateAndTime
year: 2004
month: 11
day: 2
hour: 14
minute: 0
second: 0
offset: 0 hours.
twoPmUTCInLocalTimeOfDetroit := twoPmInLondon utcOffset: -5 hours.
nineAmInDetroit := '2004-11-02T09:00:00-05:00' asDateAndTime.
self assert: twoPmUTCInLocalTimeOfDetroit = nineAmInDetroit.
!
----- Method: DateAndTimeTest>>testDateTimeDenotation2 (in category 'Tests') -----
testDateTimeDenotation2
"DateAndTimeTest new testDateTimeDenotation2"
" Moscow is 3 hours ahead UTC, this offset to UTC is therefore positive. This example tests the correct interpretation of the DateAndTime denotation. "
| lateEveningInLondon lateEveningInLocalTimeOfMoscow
localMoscowTimeFromDenotation |
lateEveningInLondon := DateAndTime
year: 2004
month: 11
day: 30
hour: 23
minute: 30
second: 0
offset: 0 hours.
lateEveningInLocalTimeOfMoscow := lateEveningInLondon utcOffset: 3 hours.
localMoscowTimeFromDenotation := '2004-12-01T02:30:00+03:00' asDateAndTime.
self assert: lateEveningInLocalTimeOfMoscow = localMoscowTimeFromDenotation.
!
----- Method: DateAndTimeTest>>testErrorWhenDayIsAfterMonthEnd (in category 'Tests') -----
testErrorWhenDayIsAfterMonthEnd
self
should:
[DateAndTime
year: 2004
month: 2
day: 30]
raise: Error.
self
shouldnt:
[DateAndTime
year: 2004
month: 2
day: 29]
raise: Error.
!
----- Method: DateAndTimeTest>>testErrorWhenDayIsBeforeMonthStart (in category 'Tests') -----
testErrorWhenDayIsBeforeMonthStart
self
should:
[DateAndTime
year: 2004
month: 2
day: -1]
raise: Error.
self
should:
[DateAndTime
year: 2004
month: 2
day: 0]
raise: Error.
self
shouldnt:
[DateAndTime
year: 2004
month: 2
day: 1]
raise: Error.
!
----- Method: DateAndTimeTest>>testInstanceCreation (in category 'Tests') -----
testInstanceCreation
| t |
t := DateAndTime
year: 1 month: 1 day: 2
hour: 2 minute: 3 second: 4 nanoSecond: 5
offset: 6 hours.
self
assert: (t julianDayNumber = 1721427);
assert: (t offset = 6 hours);
assert: (t hour = 2);
assert: (t minute = 3);
assert: (t second = 4);
assert: (t nanoSecond = 5).
!
----- Method: DateAndTimeTest>>testMonotonicity (in category 'Tests') -----
testMonotonicity
| t1 t2 t3 t4 |
t1 := DateAndTime now.
t2 := DateAndTime now.
(Delay forMilliseconds: 1000) wait.
t3 := DateAndTime now.
t4 := DateAndTime now.
self
assert: ( t1 <= t2);
assert: ( t2 < t3);
assert: ( t3 <= t4).
!
----- Method: DateAndTimeTest>>testPrintString (in category 'Tests') -----
testPrintString
"(self new setTestSelector: #testPrintString) debug"
| dt |
dt :=DateAndTime
year: 2004
month: 11
day: 2
hour: 14
minute: 3
second: 5
nanoSecond: 12345
offset: (Duration seconds: (5 * 3600)).
self assert: dt printString = '2004-11-02T14:03:05.000012345+05:00'
!
----- Method: DateAndTimeTest>>testSmalltalk80Accessors (in category 'Tests') -----
testSmalltalk80Accessors
| t |
t := DateAndTime
year: 1 month: 1 day: 2
hour: 2 minute: 3 second: 4 nanoSecond: 5
offset: 6 hours.
self
assert: (t hours = t hours);
assert: (t minutes = t minute);
assert: (t seconds = t second).
!
----- Method: DateAndTimeTest>>testTimeZoneEquivalence (in category 'Tests') -----
testTimeZoneEquivalence
"DateAndTimeTest new testTimeZoneEquivalence"
"When the clock on the wall in Detroit says 9:00am, the clock on the wall
in London says 2:00pm. The Duration difference between the corresponding
DateAndTime values should be zero."
" Detroit is 5 hours behind UTC, this offset to UTC is therefore written with a minus sign. This example tests both the correct interpretation of the DateAndTime denotation and correct DateAndTime arithmetics. "
| twoPmInLondon nineAmInDetroit durationDifference |
twoPmInLondon := '2004-11-02T14:00:00+00:00' asDateAndTime.
nineAmInDetroit := '2004-11-02T09:00:00-05:00' asDateAndTime.
durationDifference := twoPmInLondon - nineAmInDetroit.
self assert: durationDifference asSeconds = 0.
self assert: twoPmInLondon = nineAmInDetroit
!
----- Method: DateAndTimeTest>>testTimeZoneEquivalence2 (in category 'Tests') -----
testTimeZoneEquivalence2
"DateAndTimeTest new testTimeZoneEquivalence2"
"This example demonstates the fact that
2004-05-24T22:40:00 UTC is
2004-05-25T01:40:00 in Moscow
(Moscow is 3 hours ahead of UTC) "
| thisMoment thisMomentInMoscow |
thisMoment := DateAndTime year: 2004 month: 5 day: 24 hour: 22 minute: 40.
thisMomentInMoscow := thisMoment utcOffset: 3 hours.
self assert: (thisMoment - thisMomentInMoscow) asSeconds = 0.
self assert: thisMoment = thisMomentInMoscow
!
ClassTestCase subclass: #DateTest
instanceVariableNames: 'date aDate aTime'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!DateTest commentStamp: 'brp 7/26/2003 16:58' prior: 0!
This is the unit test for the class Date. !
----- Method: DateTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ self dateClass!
----- Method: DateTest>>dateClass (in category 'Private') -----
dateClass
^ Date!
----- Method: DateTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| deprecated private special |
deprecated := #().
private := #().
special := #( #< #= #new #next #previous #printOn: #printOn:format: #storeOn: #fromString: ).
^ super selectorsToBeIgnored, deprecated, private, special!
----- Method: DateTest>>setUp (in category 'Running') -----
setUp
date := self dateClass newDay: 153 year: 1973. "2 June 1973"
aDate := Date readFrom: '01-23-2004' readStream.
aTime := Time readFrom: '12:34:56 pm' readStream!
----- Method: DateTest>>testAccessing (in category 'Tests') -----
testAccessing
self
assert: date day = 153;
assert: date julianDayNumber = 2441836;
assert: date leap = 0;
assert: date monthIndex = 6;
assert: date monthName = #June;
assert: date weekday = #Saturday;
assert: date weekdayIndex = 7;
assert: date year = 1973.
!
----- Method: DateTest>>testAddDays (in category 'testing') -----
testAddDays
self assert: (aDate addDays: 00) yyyymmdd = '2004-01-23'.
self assert: (aDate addDays: 30) yyyymmdd = '2004-02-22'.
self assert: (aDate addDays: 60) yyyymmdd = '2004-03-23'.
self assert: (aDate addDays: 90) yyyymmdd = '2004-04-22'.
self assert: (aDate addDays:120) yyyymmdd = '2004-05-22'!
----- Method: DateTest>>testAddMonths (in category 'testing') -----
testAddMonths
self assert: (aDate addMonths: 0) yyyymmdd = '2004-01-23'.
self assert: (aDate addMonths: 1) yyyymmdd = '2004-02-23'.
self assert: (aDate addMonths: 2) yyyymmdd = '2004-03-23'.
self assert: (aDate addMonths: 3) yyyymmdd = '2004-04-23'.
self assert: (aDate addMonths: 12) yyyymmdd = '2005-01-23'.
self assert: ((Date readFrom: '05-31-2017' readStream) addMonths: 1) yyyymmdd = '2017-06-30'.
self assert: ((Date readFrom: '02-29-2000' readStream) addMonths: 12) yyyymmdd = '2001-02-28'!
----- Method: DateTest>>testArithmetic (in category 'Tests') -----
testArithmetic
| d |
d := date addDays: 32. "4 July 1973"
self
assert: d year = 1973;
assert: d monthIndex = 7;
assert: d dayOfMonth = 4.
self
assert: (d subtractDate: date) = 32;
assert: (date subtractDate: d) = -32.
self
assert: (d subtractDays: 32) = date.
!
----- Method: DateTest>>testAsDate (in category 'testing') -----
testAsDate
self assert: (aDate asDate) = aDate
!
----- Method: DateTest>>testAsSeconds (in category 'testing') -----
testAsSeconds
self assert: (aDate asSeconds) = 3252268800.
self assert: (aDate asSeconds) = ((103*365*24*60*60) + (22+25"leap days"*24*60*60)) .
self assert: aDate = (Date fromSeconds: 3252268800).!
----- Method: DateTest>>testComparing (in category 'Tests') -----
testComparing
| d1 d2 d3 |
d1 := self dateClass newDay: 2 month: #June year: 1973.
d2 := self dateClass newDay: 97 year: 2003. "7 April 2003"
d3 := self dateClass newDay: 250 year: 1865. "7 September 1865"
self
assert: date = d1;
assert: date = date copy;
assert: date hash = d1 hash.
self
assert: date < d2;
deny: date < d3.
!
----- Method: DateTest>>testConverting (in category 'Tests') -----
testConverting
self
assert: date asDate = date;
assert: '2 June 1973' asDate = date;
assert: date asSeconds = 2285280000.
date dayMonthYearDo: [ :d :m :y | self assert: d = 2; assert: m = 6; assert: y = 1973 ].!
----- Method: DateTest>>testDateAndTimeNow (in category 'testing') -----
testDateAndTimeNow
"Not a great test: could falsely fail if midnight come in between the two executions and doesnt catch time errors"
self assert: Date dateAndTimeNow first = Date today
!
----- Method: DateTest>>testDayMonthYearDo (in category 'testing') -----
testDayMonthYearDo
self assert: (aDate dayMonthYearDo: [:day :month :year | day asString , month asString, year asString]) = '2312004'
!
----- Method: DateTest>>testDaysInMonthForYear (in category 'testing') -----
testDaysInMonthForYear
self assert: (Date daysInMonth: 'February' forYear: 2008) = 29.
self assert: (Date daysInMonth: 'February' forYear: 2000) = 29.
self assert: (Date daysInMonth: 'February' forYear: 2100) = 28.
self assert: (Date daysInMonth: 'July' forYear: 2100) = 31. !
----- Method: DateTest>>testDaysInYear (in category 'testing') -----
testDaysInYear
self assert: (Date daysInYear: 2008) = 366.
self assert: (Date daysInYear: 2000) = 366.
self assert: (Date daysInYear: 2100) = 365
!
----- Method: DateTest>>testDuration (in category 'testing') -----
testDuration
self assert: aDate duration = 24 hours!
----- Method: DateTest>>testEqual (in category 'testing') -----
testEqual
self assert: aDate = (Date readFrom: 'January 23, 2004' readStream)!
----- Method: DateTest>>testFirstWeekdayOfMonthYear (in category 'testing') -----
testFirstWeekdayOfMonthYear
self assert: (Date firstWeekdayOfMonth: 'January' year: 2004) = 5.
!
----- Method: DateTest>>testFromDays (in category 'Tests') -----
testFromDays
| epoch d0 d1 d2 |
epoch := self dateClass newDay: 1 year: 1901.
d0 := self dateClass fromDays: 0. "1 January 1901"
self assert: d0 = epoch.
d1 := self dateClass fromDays: 26450. "2 June 1973"
self assert: d1 = date.
d2 := self dateClass fromDays: -100000. "18 March 1627"
self assert: d2 julianDayNumber = 2315386.
self assert: aDate = (Date fromDays: 37642).
self assert: aDate = (Date fromDays: 103*365 + 22 + 25 "leap days") .
!
----- Method: DateTest>>testFromSeconds (in category 'Tests') -----
testFromSeconds
| d |
d := self dateClass fromSeconds: 2285280000.
self
assert: d = date.
!
----- Method: DateTest>>testGeneralInquiries (in category 'Tests') -----
testGeneralInquiries
| shuffled indices names now |
shuffled := #(#January #February #March #April #May #June #July
#August #September #October #November #December) shuffled.
indices := shuffled collect: [ :m | self dateClass indexOfMonth: m ].
names := indices collect: [ :i | self dateClass nameOfMonth: i ].
self assert: names = shuffled.
shuffled := #(#Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday) shuffled.
indices := shuffled collect: [ :m | self dateClass dayOfWeek: m ].
names := indices collect: [ :i | self dateClass nameOfDay: i ].
self assert: names = shuffled.
now := self dateClass dateAndTimeNow.
self
assert: now size = 2;
assert: now first = self dateClass today.
self assert: (self dateClass firstWeekdayOfMonth: #June year: 1973) = 6.
self
assert: (self dateClass leapYear: 1973) = 0;
assert: (self dateClass leapYear: 1972) = 1;
assert: (self dateClass daysInYear: 1973) = 365;
assert: (self dateClass daysInYear: 1972) = 366;
assert: (self dateClass daysInMonth: #February forYear: 1973) = 28;
assert: (self dateClass daysInMonth: #February forYear: 1972) = 29.
!
----- Method: DateTest>>testIndexOfMonth (in category 'testing') -----
testIndexOfMonth
self assert: (Date indexOfMonth: 'January') = 1.
self assert: (Date indexOfMonth: 'December') = 12. !
----- Method: DateTest>>testInitialization (in category 'Tests') -----
testInitialization
self should: [ self dateClass initialize. true ].
!
----- Method: DateTest>>testInquiries (in category 'Tests') -----
testInquiries
self
assert: date dayOfMonth = 2;
assert: date dayOfYear = 153;
assert: date daysInMonth = 30;
assert: date daysInYear = 365;
assert: date daysLeftInYear = (365 - 153);
assert: date firstDayOfMonth = 152.
!
----- Method: DateTest>>testJulianDayNumber (in category 'testing') -----
testJulianDayNumber
self assert: aDate = (Date julianDayNumber: ((4713+2004)*365 +1323) ). !
----- Method: DateTest>>testLeap (in category 'testing') -----
testLeap
self assert: aDate leap = 1.
!
----- Method: DateTest>>testLeapNot (in category 'testing') -----
testLeapNot
self assert: (aDate addDays: 365) leap = 0
!
----- Method: DateTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aDate < (Date readFrom: '01-24-2004' readStream)!
----- Method: DateTest>>testMmddyyyy (in category 'testing') -----
testMmddyyyy
self assert: aDate mmddyyyy = '1/23/2004'!
----- Method: DateTest>>testNameOfMonth (in category 'testing') -----
testNameOfMonth
self assert: (Date nameOfMonth: 5) = 'May'.
self assert: (Date nameOfMonth: 8) = 'August' !
----- Method: DateTest>>testNew (in category 'Tests') -----
testNew
| epoch |
epoch := self dateClass newDay: 1 year: 1901.
self assert: (self dateClass new = epoch).!
----- Method: DateTest>>testNewDayMonthYear (in category 'testing') -----
testNewDayMonthYear
self assert: aDate = (Date newDay: 23 month: 1 year: 2004)
!
----- Method: DateTest>>testNewDayYear (in category 'testing') -----
testNewDayYear
self assert: aDate = (Date newDay: 23 year: 2004)
!
----- Method: DateTest>>testPreviousFriday (in category 'testing') -----
testPreviousFriday
self assert: (aDate previous: 'Friday') yyyymmdd = '2004-01-16'
!
----- Method: DateTest>>testPreviousNext (in category 'Tests') -----
testPreviousNext
| n p pt ps |
n := date next.
p := date previous.
self
assert: n year = 1973;
assert: n dayOfYear = 154;
assert: p year = 1973;
assert: p dayOfYear = 152.
pt := date previous: #Thursday. "31 May 1973"
self
assert: pt year = 1973;
assert: pt dayOfYear = 151.
ps := date previous: #Saturday. " 26 May 1973"
self
assert: ps year = 1973;
assert: ps dayOfYear = (153-7).
!
----- Method: DateTest>>testPreviousThursday (in category 'testing') -----
testPreviousThursday
self assert: (aDate previous: 'Thursday') yyyymmdd = '2004-01-22'
!
----- Method: DateTest>>testPrintFormat (in category 'testing') -----
testPrintFormat
self assert: (aDate printFormat: #(1 2 3 $? 2 2)) = '23?Jan?04'!
----- Method: DateTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '23 January 2004' readStream.
rw := ReadWriteStream on: ''.
aDate printOn: rw.
self assert: rw contents = cs contents!
----- Method: DateTest>>testPrintOnFormat (in category 'testing') -----
testPrintOnFormat
| cs rw |
cs := '04*Jan*23' readStream.
rw := ReadWriteStream on: ''.
aDate
printOn: rw
format: #(3 2 1 $* 2 2 ).
self assert: rw contents = cs contents!
----- Method: DateTest>>testPrinting (in category 'Tests') -----
testPrinting
self
assert: date mmddyyyy = '6/2/1973';
assert: date yyyymmdd = '1973-06-02';
assert: (date printFormat: #(3 1 2 $!! 2 1 1)) = '1973!!2!!Jun'.
!
----- Method: DateTest>>testReadFrom (in category 'Tests') -----
testReadFrom
| s1 s2 s3 s4 s5 |
s1 := '2 June 1973'.
s2 := '2-JUN-73'.
s3 := 'June 2, 1973'.
s4 := '6/2/73'.
s5 := '2JUN73'.
self
assert: date = (self dateClass readFrom: s1 readStream);
assert: date = (self dateClass readFrom: s2 readStream);
assert: date = (self dateClass readFrom: s3 readStream);
assert: date = (self dateClass readFrom: s4 readStream);
assert: date = (self dateClass readFrom: s5 readStream).!
----- Method: DateTest>>testStarting (in category 'testing') -----
testStarting
self assert: aDate = (Date starting: (DateAndTime fromString: '2004-01-23T12:12')). !
----- Method: DateTest>>testStoreOn (in category 'testing') -----
testStoreOn
| cs rw |
cs := '''23 January 2004'' asDate' readStream.
rw := ReadWriteStream on: ''.
aDate storeOn: rw.
self assert: rw contents = cs contents!
----- Method: DateTest>>testStoring (in category 'Tests') -----
testStoring
self
assert: date storeString = '''2 June 1973'' asDate';
assert: date = ('2 June 1973' asDate).
!
----- Method: DateTest>>testSubtractDate (in category 'testing') -----
testSubtractDate
self assert: (aDate subtractDate:(aDate addDays: 30)) = -30.
self assert: (aDate subtractDate:(aDate subtractDays: 00)) = 0.
self assert: (aDate subtractDate:(aDate subtractDays: 30)) = 30.
!
----- Method: DateTest>>testSubtractDays (in category 'testing') -----
testSubtractDays
self assert: (aDate subtractDays: 00) yyyymmdd = '2004-01-23'.
self assert: (aDate subtractDays: 30) yyyymmdd = '2003-12-24'.
self assert: (aDate subtractDays: 60) yyyymmdd = '2003-11-24'
!
----- Method: DateTest>>testTomorrow (in category 'testing') -----
testTomorrow
"Not a great test: could falsely fail if midnight come in between the two executions and doesnt catch many errors"
self assert: Date tomorrow > Date today
!
----- Method: DateTest>>testWeekday (in category 'testing') -----
testWeekday
self assert: aDate weekday = 'Friday'.
self assert: aDate weekdayIndex = 6.
self assert: (Date dayOfWeek: aDate weekday ) =6.
self assert: (Date nameOfDay: 6 ) = 'Friday' !
----- Method: DateTest>>testYesterday (in category 'testing') -----
testYesterday
"Not a great test: doesnt catch many errors"
self assert: Date yesterday < Date today
!
----- Method: DateTest>>testYyyymmdd (in category 'testing') -----
testYyyymmdd
self assert: aDate yyyymmdd = '2004-01-23'!
ClassTestCase subclass: #DurationTest
instanceVariableNames: 'aDuration'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: DurationTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Duration
!
----- Method: DurationTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| private |
private := #( #printOn: ).
^ super selectorsToBeIgnored, private
!
----- Method: DurationTest>>setUp (in category 'running') -----
setUp
aDuration := Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5 !
----- Method: DurationTest>>testAbs (in category 'testing') -----
testAbs
self assert: aDuration abs = aDuration.
self assert: (Duration nanoSeconds: -5) abs = (Duration nanoSeconds: 5).
!
----- Method: DurationTest>>testAsDelay (in category 'testing') -----
testAsDelay
self deny: aDuration asDelay = aDuration.
"want to come up with a more meaningful test"
!
----- Method: DurationTest>>testAsDuration (in category 'testing') -----
testAsDuration
self assert: aDuration asDuration = aDuration
!
----- Method: DurationTest>>testAsMilliSeconds (in category 'testing') -----
testAsMilliSeconds
self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1.
self assert: (Duration seconds: 1) asMilliSeconds = 1000.
self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1.
self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1.
self assert: aDuration asMilliSeconds = 93784000.!
----- Method: DurationTest>>testAsNanoSeconds (in category 'testing') -----
testAsNanoSeconds
self assert: (Duration nanoSeconds: 1) asNanoSeconds = 1.
self assert: (Duration seconds: 1) asNanoSeconds = 1000000000.
self assert: aDuration asNanoSeconds = 93784000000005.!
----- Method: DurationTest>>testAsSeconds (in category 'testing') -----
testAsSeconds
self assert: (Duration nanoSeconds: 1000000000) asSeconds = 1.
self assert: (Duration seconds: 1) asSeconds = 1.
self assert: aDuration asSeconds = 93784.!
----- Method: DurationTest>>testComparing (in category 'Tests') -----
testComparing
| d1 d2 d3 |
d1 := Duration seconds: 10 nanoSeconds: 1.
d2 := Duration seconds: 10 nanoSeconds: 1.
d3 := Duration seconds: 10 nanoSeconds: 2.
self
assert: (d1 = d1);
assert: (d1 = d2);
deny: (d1 = d3);
assert: (d1 < d3)
!
----- Method: DurationTest>>testDays (in category 'testing') -----
testDays
self assert: aDuration days = 1.
self assert: (Duration days: 1) days= 1. !
----- Method: DurationTest>>testDivide (in category 'testing') -----
testDivide
self assert: aDuration / aDuration = 1.
self assert: aDuration / 2 = (Duration days: 0 hours: 13 minutes: 1 seconds: 32 nanoSeconds: 2).
self assert: aDuration / (1/2) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10).
!
----- Method: DurationTest>>testFromString (in category 'testing') -----
testFromString
self assert: aDuration = (Duration fromString: '1:02:03:04.000000005').
!
----- Method: DurationTest>>testHash (in category 'testing') -----
testHash
self assert: aDuration hash = (Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) hash!
----- Method: DurationTest>>testHours (in category 'testing') -----
testHours
self assert: aDuration hours = 2.
self assert: (Duration hours: 2) hours = 2. !
----- Method: DurationTest>>testIntegerDivision (in category 'testing') -----
testIntegerDivision
self assert: aDuration // aDuration = 1.
self assert: aDuration // 2 = (aDuration / 2).
"is there ever a case where this is not true, since precision is always to the nano second?"!
----- Method: DurationTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aDuration < (aDuration + 1 day ).
self deny: aDuration < aDuration.
!
----- Method: DurationTest>>testMilliSeconds (in category 'testing') -----
testMilliSeconds
self assert: (Duration milliSeconds: 5) nanoSeconds = 5000000. !
----- Method: DurationTest>>testMinus (in category 'testing') -----
testMinus
self assert: aDuration - aDuration = (Duration seconds: 0).
self assert: aDuration - (Duration days: -1 hours: -2 minutes: -3 seconds: -4 nanoSeconds: -5) =
(Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10).
self assert: aDuration - (Duration days: 0 hours: 1 minutes: 2 seconds: 3 nanoSeconds: 4) =
(Duration days: 1 hours: 1 minutes: 1 seconds: 1 nanoSeconds: 1).
self assert: aDuration - (Duration days: 0 hours: 3 minutes: 0 seconds: 5 nanoSeconds: 0) =
(Duration days: 0 hours: 23 minutes: 2 seconds: 59 nanoSeconds: 5). !
----- Method: DurationTest>>testMinutes (in category 'testing') -----
testMinutes
self assert: aDuration minutes = 3.
self assert: (Duration minutes: 3) minutes = 3. !
----- Method: DurationTest>>testModulo (in category 'Tests') -----
testModulo
| d1 d2 d3 |
d1 := 11.5 seconds.
d2 := d1 \\ 3.
self assert: d2 = (Duration nanoSeconds: 1).
d3 := d1 \\ (3 seconds).
self assert: d3 = (Duration seconds: 2 nanoSeconds: 500000000).
self assert: aDuration \\ aDuration =
(Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0).
self assert: aDuration \\ 2 =
(Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 1).
!
----- Method: DurationTest>>testMonthDurations (in category 'Tests') -----
testMonthDurations
| jan feb dec |
jan := Duration month: #January.
feb := Duration month: #February.
dec := Duration month: #December.
self
assert: jan = (Year current months first duration);
assert: feb = (Year current months second duration);
assert: dec = (Year current months last duration)
!
----- Method: DurationTest>>testMultiply (in category 'testing') -----
testMultiply
self assert: aDuration * 2 = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). !
----- Method: DurationTest>>testNanoSeconds (in category 'testing') -----
testNanoSeconds
self assert: aDuration nanoSeconds = 5.
self assert: (Duration nanoSeconds: 5) nanoSeconds = 5. !
----- Method: DurationTest>>testNegated (in category 'testing') -----
testNegated
self assert: aDuration + aDuration negated = (Duration seconds: 0).
!
----- Method: DurationTest>>testNegative (in category 'testing') -----
testNegative
self deny: aDuration negative.
self assert: aDuration negated negative
!
----- Method: DurationTest>>testNew (in category 'testing') -----
testNew
"self assert: Duration new = (Duration seconds: 0)."
"new is not valid as a creation method: MessageNotUnderstood: UndefinedObject>>quo:, where Duration seconds is nil"!
----- Method: DurationTest>>testNumberConvenienceMethods (in category 'Tests') -----
testNumberConvenienceMethods
self
assert: 1 week = (Duration days: 7);
assert: -1 week = (Duration days: -7);
assert: 1 day = (Duration days: 1);
assert: -1 day = (Duration days: -1);
assert: 1 hours = (Duration hours: 1);
assert: -1 hour = (Duration hours: -1);
assert: 1 minute = (Duration seconds: 60);
assert: -1 minute = (Duration seconds: -60);
assert: 1 second = (Duration seconds: 1);
assert: -1 second = (Duration seconds: -1);
assert: 1 milliSecond = (Duration milliSeconds: 1);
assert: -1 milliSecond = (Duration milliSeconds: -1);
assert: 1 nanoSecond = (Duration nanoSeconds: 1);
assert: -1 nanoSecond = (Duration nanoSeconds: -1)
!
----- Method: DurationTest>>testPlus (in category 'testing') -----
testPlus
self assert: (aDuration + 0 hours) = aDuration.
self assert: (aDuration + aDuration) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). !
----- Method: DurationTest>>testPositive (in category 'testing') -----
testPositive
self assert: (Duration nanoSeconds: 0) positive.
self assert: aDuration positive.
self deny: aDuration negated positive
!
----- Method: DurationTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '1:02:03:04.000000005' readStream.
rw := ReadWriteStream on: ''.
aDuration printOn: rw.
self assert: rw contents = cs contents!
----- Method: DurationTest>>testQuotient (in category 'Tests') -----
testQuotient
| d1 d2 q |
d1 := 11.5 seconds.
d2 := d1 // 3.
self assert: d2 = (Duration seconds: 3 nanoSeconds: 833333333).
q := d1 // (3 seconds).
self assert: q = 3.
!
----- Method: DurationTest>>testReadFrom (in category 'testing') -----
testReadFrom
self assert: aDuration = (Duration readFrom: '1:02:03:04.000000005' readStream)!
----- Method: DurationTest>>testRoundTo (in category 'Tests') -----
testRoundTo
self assert: ((5 minutes + 37 seconds) roundTo: (2 minutes)) = (6 minutes).
self assert: (aDuration roundTo: (Duration days: 1)) =
(Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0).
self assert: (aDuration roundTo: (Duration hours: 1)) =
(Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0).
self assert: (aDuration roundTo: (Duration minutes: 1)) =
(Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).!
----- Method: DurationTest>>testSeconds (in category 'testing') -----
testSeconds
self assert: aDuration seconds = (800000001/200000000).
self assert: (Duration nanoSeconds: 2) seconds = (2/1000000000).
self assert: (Duration seconds: 2) seconds = 2.
self assert: (Duration days: 1 hours: 2 minutes: 3 seconds:4) seconds = (4).
self deny: (Duration days: 1 hours: 2 minutes: 3 seconds:4) seconds = (1*24*60*60+(2*60*60)+(3*60)+4). !
----- Method: DurationTest>>testSecondsNanoSeconds (in category 'testing') -----
testSecondsNanoSeconds
self assert: (Duration seconds: 0 nanoSeconds: 5) = (Duration nanoSeconds: 5).
"not sure I should include in sunit since its Private "
self assert: (aDuration seconds: 0 nanoSeconds: 1) = (Duration nanoSeconds: 1).
!
----- Method: DurationTest>>testStoreOn (in category 'testing') -----
testStoreOn
self assert: (aDuration storeOn: (WriteStream on:'')) asString ='1:02:03:04.000000005'.
"storeOn: returns a duration (self) not a stream"!
----- Method: DurationTest>>testTicks (in category 'testing') -----
testTicks
self assert: aDuration ticks = #(1 7384 5)!
----- Method: DurationTest>>testTruncateTo (in category 'Tests') -----
testTruncateTo
self assert: ((5 minutes + 37 seconds) truncateTo: (2 minutes)) = (4 minutes).
self assert: (aDuration truncateTo: (Duration days: 1)) =
(Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0).
self assert: (aDuration truncateTo: (Duration hours: 1)) =
(Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0).
self assert: (aDuration truncateTo: (Duration minutes: 1)) =
(Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).!
----- Method: DurationTest>>testWeeks (in category 'testing') -----
testWeeks
self assert: (Duration weeks: 1) days= 7. !
----- Method: DurationTest>>testZero (in category 'testing') -----
testZero
self assert: (Duration zero) = (Duration seconds: 0). !
ClassTestCase subclass: #FalseTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
!FalseTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class False. 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
!
----- Method: FalseTest>>testAND (in category 'tests') -----
testAND
self assert: (false & true) = false.
self assert: (false & false) = false.!
----- Method: FalseTest>>testAnd (in category 'tests') -----
testAnd
self assert: (false and: ['alternativeBlock']) = false.!
----- Method: FalseTest>>testIfFalse (in category 'tests') -----
testIfFalse
self assert: ((false ifFalse: ['alternativeBlock']) = 'alternativeBlock'). !
----- Method: FalseTest>>testIfFalseIfTrue (in category 'tests') -----
testIfFalseIfTrue
self assert: (false ifFalse: ['falseAlternativeBlock']
ifTrue: ['trueAlternativeBlock']) = 'falseAlternativeBlock'. !
----- Method: FalseTest>>testIfTrue (in category 'tests') -----
testIfTrue
self assert: (false ifTrue: ['alternativeBlock']) = nil. !
----- Method: FalseTest>>testIfTrueIfFalse (in category 'tests') -----
testIfTrueIfFalse
self assert: (false ifTrue: ['trueAlternativeBlock']
ifFalse: ['falseAlternativeBlock']) = 'falseAlternativeBlock'. !
----- Method: FalseTest>>testNew (in category 'tests') -----
testNew
self should: [False new] raise: TestResult error. !
----- Method: FalseTest>>testNot (in category 'tests') -----
testNot
self assert: (false not = true).!
----- Method: FalseTest>>testOR (in category 'tests') -----
testOR
self assert: (false | true) = true.
self assert: (false | false) = false.!
----- Method: FalseTest>>testOr (in category 'tests') -----
testOr
self assert: (false or: ['alternativeBlock']) = 'alternativeBlock'.!
----- Method: FalseTest>>testPrintOn (in category 'tests') -----
testPrintOn
self assert: (String streamContents: [:stream | false printOn: stream]) = 'false'. !
ClassTestCase subclass: #FloatTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
!FloatTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0!
I provide a test suite for Float values. Examine my tests to see how Floats should behave, and see how to use them.!
----- Method: FloatTest>>test32bitGradualUnderflow (in category 'IEEE 754') -----
test32bitGradualUnderflow
"method asIEEE32BitWord did not respect IEEE gradual underflow"
| conv expected exponentPart |
"IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1
2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign
except when 2reeeeeeee isZero, which is a gradual underflow:
2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-126) * sign
and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise"
"case 1: This example is the first gradual underflow case"
conv := 2r0.11111111111111111111111e-126 asIEEE32BitWord.
"expected float encoded as sign/exponent/mantissa (whithout leading 1 or 0)"
exponentPart := 0.
expected := exponentPart bitOr: 2r11111111111111111111111.
self assert: expected = conv.
"case 2: smallest number"
conv := 2r0.00000000000000000000001e-126 asIEEE32BitWord.
expected := exponentPart bitOr: 2r1.
self assert: expected = conv.
"case 3: round to nearest even also in underflow cases... here round to upper"
conv := 2r0.000000000000000000000011e-126 asIEEE32BitWord.
expected := exponentPart bitOr: 2r10.
self assert: expected = conv.
"case 4: round to nearest even also in underflow cases... here round to lower"
conv := 2r0.000000000000000000000101e-126 asIEEE32BitWord.
expected := exponentPart bitOr: 2r10.
self assert: expected = conv.
"case 5: round to nearest even also in underflow cases... here round to upper"
conv := 2r0.0000000000000000000001011e-126 asIEEE32BitWord.
expected := exponentPart bitOr: 2r11.
self assert: expected = conv.
!
----- Method: FloatTest>>test32bitRoundingMode (in category 'IEEE 754') -----
test32bitRoundingMode
"method asIEEE32BitWord did not respect IEEE default rounding mode"
| conv expected exponentPart |
"IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1
2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign
except when 2reeeeeeee isZero, which is a gradual underflow:
2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-127) * sign
and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise"
"This example has two extra bits in mantissa for testing rounding mode
case 1: should obviously round to upper"
conv := 2r1.0000000000000000000000111e25 asIEEE32BitWord.
"expected float encoded as sign/exponent/mantissa (whithout leading 1)"
exponentPart := 25+127 bitShift: 23. "127 is 2r01111111 or 16r7F"
expected := exponentPart bitOr: 2r10.
self assert: expected = conv.
"case 2: exactly in the mid point of two 32 bit float: round toward nearest even (to upper)"
conv := 2r1.0000000000000000000000110e25 asIEEE32BitWord.
expected := exponentPart bitOr: 2r10.
self assert: expected = conv.
"case 3: exactly in the mid point of two 32 bit float: round toward nearest even (to lower)"
conv := 2r1.0000000000000000000000010e25 asIEEE32BitWord.
expected := exponentPart bitOr: 2r0.
self assert: expected = conv.
"case 4: obviously round to upper"
conv := 2r1.0000000000000000000000011e25 asIEEE32BitWord.
expected := exponentPart bitOr: 2r1.
self assert: expected = conv.
!
----- Method: FloatTest>>testContinuedFractions (in category 'testing - arithmetic') -----
testContinuedFractions
self assert: (Float pi asApproximateFractionAtOrder: 1) = (22/7).
self assert: (Float pi asApproximateFractionAtOrder: 3) = (355/113)!
----- Method: FloatTest>>testDivide (in category 'testing - arithmetic') -----
testDivide
self assert: 2.0 / 1 = 2.
self should: [ 2.0 / 0 ] raise: ZeroDivide.!
----- Method: FloatTest>>testFloatTruncated (in category 'testing - conversion') -----
testFloatTruncated
"(10 raisedTo: 16) asFloat has an exact representation (no round off error).
It should convert back to integer without loosing bits.
This is a no regression test on http://bugs.impara.de/view.php?id=3504"
| x y int r |
int := 10 raisedTo: 16.
x := int asFloat.
y := (5 raisedTo: 16) asFloat timesTwoPower: 16.
self assert: x = y.
self assert: x asInteger = int.
"this one should be true for any float"
self assert: x asInteger = x asTrueFraction asInteger.
"a random test"
r := Random new.
10000 timesRepeat: [
x := r next * 1.9999e16 + 1.0e12 .
self assert: x truncated = x asTrueFraction truncated]!
----- Method: FloatTest>>testFractionAsFloat (in category 'testing - conversion') -----
testFractionAsFloat
"use a random test"
| r m frac err collec |
r := Random new seed: 1234567.
m := (2 raisedTo: 54) - 1.
200 timesRepeat: [
frac := ((r nextInt: m) * (r nextInt: m) + 1) / ((r nextInt: m) * (r nextInt: m) + 1).
err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52).
self assert: err < (1/2)].
collec := #(16r10000000000000 16r1FFFFFFFFFFFFF 1 2 16r20000000000000 16r20000000000001 16r3FFFFFFFFFFFFF 16r3FFFFFFFFFFFFE 16r3FFFFFFFFFFFFD).
collec do: [:num |
collec do: [:den |
frac := Fraction numerator: num denominator: den.
err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52).
self assert: err <= (1/2)]].!
----- Method: FloatTest>>testFractionAsFloat2 (in category 'testing - conversion') -----
testFractionAsFloat2
"test rounding to nearest even"
self assert: ((1<<52)+0+(1/4)) asFloat asTrueFraction = ((1<<52)+0).
self assert: ((1<<52)+0+(1/2)) asFloat asTrueFraction = ((1<<52)+0).
self assert: ((1<<52)+0+(3/4)) asFloat asTrueFraction = ((1<<52)+1).
self assert: ((1<<52)+1+(1/4)) asFloat asTrueFraction = ((1<<52)+1).
self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2).
self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).!
----- Method: FloatTest>>testInfinity1 (in category 'infinity behavior') -----
testInfinity1
"FloatTest new testInfinity1"
| i1 i2 |
i1 := 10000 exp.
i2 := 1000000000 exp.
self assert: i1 isInfinite & i2 isInfinite & (i1 = i2).
"All infinities are equal. (This is a very substantial difference to NaN's, which are never equal."
!
----- Method: FloatTest>>testInfinity2 (in category 'infinity behavior') -----
testInfinity2
"FloatTest new testInfinity2"
| i1 i2 |
i1 := 10000 exp.
i2 := 1000000000 exp.
i2 := 0 - i2. " this is entirely ok. You can compute with infinite values."
self assert: i1 isInfinite & i2 isInfinite & i1 positive & i2 negative.
self deny: i1 = i2.
"All infinities are signed. Negative infinity is not equal to Infinity"
!
----- Method: FloatTest>>testInfinity3 (in category 'IEEE 754') -----
testInfinity3
self assert: (Float infinity negated asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) =
'11111111100000000000000000000000'.
self assert: (Float fromIEEE32Bit:
(Integer readFrom: '11111111100000000000000000000000' readStream base: 2))
= Float infinity negated!
----- Method: FloatTest>>testIntegerAsFloat (in category 'testing - conversion') -----
testIntegerAsFloat
"assert IEEE 754 round to nearest even mode is honoured"
self deny: 16r1FFFFFFFFFFFF0801 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 65 bits"
self deny: 16r1FFFFFFFFFFFF0802 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 64 bits"
self assert: 16r1FFFFFFFFFFF1F800 asFloat = 16r1FFFFFFFFFFF20000 asFloat. "nearest even is upper"
self assert: 16r1FFFFFFFFFFFF0800 asFloat = 16r1FFFFFFFFFFFF0000 asFloat. "nearest even is lower"
!
----- Method: FloatTest>>testIsZero (in category 'zero behavior') -----
testIsZero
self assert: 0.0 isZero.
self deny: 0.1 isZero.!
----- Method: FloatTest>>testNaN1 (in category 'NaN behavior') -----
testNaN1
"FloatTest new testNaN1"
self assert: Float nan == Float nan.
self deny: Float nan = Float nan.
"a NaN is not equal to itself."
!
----- Method: FloatTest>>testNaN2 (in category 'NaN behavior') -----
testNaN2
"Two NaN values are always considered to be different.
On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000.
On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing
the bit pattern of the first word of a NaN produces another value that is still
considered equal to NaN. This test should work on both little endian and big
endian machines. However, it is not guaranteed to work on future 64 bit versions
of Squeak, for which Float may have different internal representations."
"FloatTest new testNaN2"
| nan1 nan2 |
nan1 := Float nan copy.
nan2 := Float nan copy.
"test two instances of NaN with the same bit pattern"
self deny: nan1 = nan2.
self deny: nan1 == nan2.
self deny: nan1 = nan1.
self assert: nan1 == nan1.
"change the bit pattern of nan1"
self assert: nan1 size == 2.
self assert: (nan1 at: 2) = 0.
nan1 at: 1 put: (nan1 at: 1) + 999.
self assert: nan1 isNaN.
self assert: nan2 isNaN.
self deny: (nan1 at: 1) = (nan2 at: 1).
"test two instances of NaN with different bit patterns"
self deny: nan1 = nan2.
self deny: nan1 == nan2.
self deny: nan1 = nan1.
self assert: nan1 == nan1
!
----- Method: FloatTest>>testNaN3 (in category 'NaN behavior') -----
testNaN3
"FloatTest new testNaN3"
| set item identitySet |
set := Set new.
set add: (item := Float nan).
self deny: (set includes: item).
identitySet := IdentitySet new.
identitySet add: (item := Float nan).
self assert: (identitySet includes: item).
"as a NaN is not equal to itself, it can not be retrieved from a set"
!
----- Method: FloatTest>>testNaN4 (in category 'NaN behavior') -----
testNaN4
"FloatTest new testNaN4"
| dict |
dict := Dictionary new.
dict at: Float nan put: #NaN.
self deny: (dict includes: Float nan).
"as a NaN is not equal to itself, it can not be retrieved when it is used as a dictionary key"
!
----- Method: FloatTest>>testNaN5 (in category 'IEEE 754') -----
testNaN5
self assert: ((Float nan asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2)
copyFrom: 2 to: 9) = '11111111'.
self assert: (Float fromIEEE32Bit:
(Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN!
----- Method: FloatTest>>testStringAsNumber (in category 'testing - conversion') -----
testStringAsNumber
"This covers parsing in Number>>readFrom:"
| aFloat |
aFloat := '10r-12.3456' asNumber.
self assert: -12.3456 = aFloat.
aFloat := '10r-12.3456e2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '10r-12.3456d2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '10r-12.3456q2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '-12.3456q2' asNumber.
self assert: -1234.56 = aFloat.
aFloat := '12.3456q2' asNumber.
self assert: 1234.56 = aFloat.
!
----- Method: FloatTest>>testZero1 (in category 'zero behavior') -----
testZero1
"FloatTest new testZero1"
self assert: Float negativeZero = 0 asFloat.
self assert: (Float negativeZero at: 1) ~= (0 asFloat at: 1).
"The negative zero has a bit representation that is different from the bit representation of the positive zero. Nevertheless, both values are defined to be equal."
!
----- Method: FloatTest>>testZero2 (in category 'IEEE 754') -----
testZero2
self assert: (Float negativeZero asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) =
'10000000000000000000000000000000'.
self assert: (Float fromIEEE32Bit:
(Integer readFrom: '10000000000000000000000000000000' readStream base: 2))
= Float negativeZero!
ClassTestCase subclass: #FractionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: FractionTest>>testDegreeCos (in category 'tests - sinuses') -----
testDegreeCos
"self run: #testDegreeCos"
self shouldnt: [ (4/3) degreeCos] raise: Error.
self assert: (1/3) degreeCos printString = '0.999983076857744'!
----- Method: FractionTest>>testDegreeSin (in category 'tests - sinuses') -----
testDegreeSin
"self run: #testDegreeSin"
self shouldnt: [ (4/3) degreeSin] raise: Error.
self assert: (1/3) degreeSin printString = '0.005817731354993834'.!
----- Method: FractionTest>>testFractionPrinting (in category 'tests - printing') -----
testFractionPrinting
self assert: (353/359) printString = '(353/359)'.
self assert: ((2/3) printStringBase: 2) = '(10/11)'.
self assert: ((2/3) storeStringBase: 2) = '(2r10/2r11)'.
self assert: ((5/7) printStringBase: 3) = '(12/21)'.
self assert: ((5/7) storeStringBase: 3) = '(3r12/3r21)'.
self assert: ((11/13) printStringBase: 4) = '(23/31)'.
self assert: ((11/13) storeStringBase: 4) = '(4r23/4r31)'.
self assert: ((17/19) printStringBase: 5) = '(32/34)'.
self assert: ((17/19) storeStringBase: 5) = '(5r32/5r34)'.
self assert: ((23/29) printStringBase: 6) = '(35/45)'.
self assert: ((23/29) storeStringBase: 6) = '(6r35/6r45)'.
self assert: ((31/37) printStringBase: 7) = '(43/52)'.
self assert: ((31/37) storeStringBase: 7) = '(7r43/7r52)'.
self assert: ((41/43) printStringBase: 8) = '(51/53)'.
self assert: ((41/43) storeStringBase: 8) = '(8r51/8r53)'.
self assert: ((47/53) printStringBase: 9) = '(52/58)'.
self assert: ((47/53) storeStringBase: 9) = '(9r52/9r58)'.
self assert: ((59/61) printStringBase: 10) = '(59/61)'.
self assert: ((59/61) storeStringBase: 10) = '(59/61)'.
self assert: ((67/71) printStringBase: 11) = '(61/65)'.
self assert: ((67/71) storeStringBase: 11) = '(11r61/11r65)'.
self assert: ((73/79) printStringBase: 12) = '(61/67)'.
self assert: ((73/79) storeStringBase: 12) = '(12r61/12r67)'.
self assert: ((83/89) printStringBase: 13) = '(65/6B)'.
self assert: ((83/89) storeStringBase: 13) = '(13r65/13r6B)'.
self assert: ((97/101) printStringBase: 14) = '(6D/73)'.
self assert: ((97/101) storeStringBase: 14) = '(14r6D/14r73)'.
self assert: ((103/107) printStringBase: 15) = '(6D/72)'.
self assert: ((103/107) storeStringBase: 15) = '(15r6D/15r72)'.
self assert: ((109/113) printStringBase: 16) = '(6D/71)'.
self assert: ((109/113) storeStringBase: 16) = '(16r6D/16r71)'.
self assert: ((127/131) printStringBase: 17) = '(78/7C)'.
self assert: ((127/131) storeStringBase: 17) = '(17r78/17r7C)'.
self assert: ((137/139) printStringBase: 18) = '(7B/7D)'.
self assert: ((137/139) storeStringBase: 18) = '(18r7B/18r7D)'.
self assert: ((149/151) printStringBase: 19) = '(7G/7I)'.
self assert: ((149/151) storeStringBase: 19) = '(19r7G/19r7I)'.
self assert: ((157/163) printStringBase: 20) = '(7H/83)'.
self assert: ((157/163) storeStringBase: 20) = '(20r7H/20r83)'.
self assert: ((167/173) printStringBase: 21) = '(7K/85)'.
self assert: ((167/173) storeStringBase: 21) = '(21r7K/21r85)'.
self assert: ((179/181) printStringBase: 22) = '(83/85)'.
self assert: ((179/181) storeStringBase: 22) = '(22r83/22r85)'.
self assert: ((191/193) printStringBase: 23) = '(87/89)'.
self assert: ((191/193) storeStringBase: 23) = '(23r87/23r89)'.
self assert: ((197/199) printStringBase: 24) = '(85/87)'.
self assert: ((197/199) storeStringBase: 24) = '(24r85/24r87)'.
self assert: ((211/223) printStringBase: 25) = '(8B/8N)'.
self assert: ((211/223) storeStringBase: 25) = '(25r8B/25r8N)'.
self assert: ((227/229) printStringBase: 26) = '(8J/8L)'.
self assert: ((227/229) storeStringBase: 26) = '(26r8J/26r8L)'.
self assert: ((233/239) printStringBase: 27) = '(8H/8N)'.
self assert: ((233/239) storeStringBase: 27) = '(27r8H/27r8N)'.
self assert: ((241/251) printStringBase: 28) = '(8H/8R)'.
self assert: ((241/251) storeStringBase: 28) = '(28r8H/28r8R)'.
self assert: ((257/263) printStringBase: 29) = '(8P/92)'.
self assert: ((257/263) storeStringBase: 29) = '(29r8P/29r92)'.
self assert: ((269/271) printStringBase: 30) = '(8T/91)'.
self assert: ((269/271) storeStringBase: 30) = '(30r8T/30r91)'.
self assert: ((277/281) printStringBase: 31) = '(8T/92)'.
self assert: ((277/281) storeStringBase: 31) = '(31r8T/31r92)'.
self assert: ((283/293) printStringBase: 32) = '(8R/95)'.
self assert: ((283/293) storeStringBase: 32) = '(32r8R/32r95)'.
self assert: ((307/311) printStringBase: 33) = '(9A/9E)'.
self assert: ((307/311) storeStringBase: 33) = '(33r9A/33r9E)'.
self assert: ((313/317) printStringBase: 34) = '(97/9B)'.
self assert: ((313/317) storeStringBase: 34) = '(34r97/34r9B)'.
self assert: ((331/337) printStringBase: 35) = '(9G/9M)'.
self assert: ((331/337) storeStringBase: 35) = '(35r9G/35r9M)'.
self assert: ((347/349) printStringBase: 36) = '(9N/9P)'.
self assert: ((347/349) storeStringBase: 36) = '(36r9N/36r9P)'.
self assert: ((-2/3) printStringBase: 2) = '(-10/11)'.
self assert: ((-2/3) storeStringBase: 2) = '(-2r10/2r11)'.
self assert: ((5/-7) printStringBase: 3) = '(-12/21)'.
self assert: ((5/-7) storeStringBase: 3) = '(-3r12/3r21)'.
!
ClassTestCase subclass: #InstructionPrinterTest
instanceVariableNames: 'tt'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Methods'!
!InstructionPrinterTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class InstructionPrinter. 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!
----- Method: InstructionPrinterTest>>example1 (in category 'examples') -----
example1
| ff|
(1 < 2) ifTrue: [tt ifNotNil: [ff := 'hallo']].
^ ff.!
----- Method: InstructionPrinterTest>>testInstructions (in category 'tests') -----
testInstructions
"just print all of methods of Object and see if no error accours"
| printer |
printer := InstructionPrinter.
Object methods do: [:method |
self shouldnt: [
String streamContents: [:stream |
(printer on: method) printInstructionsOn: stream]] raise: Error.
].
!
ClassTestCase subclass: #LargeNegativeIntegerTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: LargeNegativeIntegerTest>>testEmptyTemplate (in category 'tests') -----
testEmptyTemplate
"Check that an uninitialized instance behaves reasonably."
| i |
i := LargeNegativeInteger new: 4.
self assert: i size == 4.
self assert: i printString = '-0'.
self assert: i normalize == 0!
ClassTestCase subclass: #LargePositiveIntegerTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: LargePositiveIntegerTest>>testBitShift (in category 'tests') -----
testBitShift
"Check bitShift from and back to SmallInts"
1 to: 257 do: [:i | self should: [((i bitShift: i) bitShift: 0-i) == i]].!
----- Method: LargePositiveIntegerTest>>testEmptyTemplate (in category 'tests') -----
testEmptyTemplate
"Check that an uninitialized instance behaves reasonably."
| i |
i := LargePositiveInteger new: 4.
self assert: i size == 4.
self assert: i printString = '0'.
self assert: i normalize == 0!
----- Method: LargePositiveIntegerTest>>testMultDicAddSub (in category 'tests') -----
testMultDicAddSub
"self run: #testMultDicAddSub"
| n f f1 |
n := 100.
f := 100 factorial.
f1 := f*(n+1).
n timesRepeat: [f1 := f1 - f].
self assert: (f1 = f).
n timesRepeat: [f1 := f1 + f].
self assert: (f1 // f = (n+1)).
self assert: (f1 negated = (Number readFrom: '-' , f1 printString)).!
----- Method: LargePositiveIntegerTest>>testNormalize (in category 'tests') -----
testNormalize
"self run: #testNormalize"
"Check normalization and conversion to/from SmallInts"
self assert: ((SmallInteger maxVal + 1 - 1) == SmallInteger maxVal).
self assert: (SmallInteger maxVal + 3 - 6) == (SmallInteger maxVal-3).
self should: ((SmallInteger minVal - 1 + 1) == SmallInteger minVal).
self assert: (SmallInteger minVal - 3 + 6) == (SmallInteger minVal+3).!
ClassTestCase subclass: #MonthTest
instanceVariableNames: 'month'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!MonthTest commentStamp: 'brp 7/26/2003 22:44' prior: 0!
This is the unit test for the class Month.
!
----- Method: MonthTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Month!
----- Method: MonthTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| deprecated private special |
deprecated := #().
private := #( #printOn: ).
special := #( #next ).
^ super selectorsToBeIgnored, deprecated, private, special.!
----- Method: MonthTest>>setUp (in category 'Running') -----
setUp
super setUp.
month := Month month: 7 year: 1998.!
----- Method: MonthTest>>tearDown (in category 'Running') -----
tearDown
super tearDown.
month := nil.!
----- Method: MonthTest>>testConverting (in category 'Tests') -----
testConverting
self assert: month asDate = '1 July 1998' asDate!
----- Method: MonthTest>>testEnumerating (in category 'Tests') -----
testEnumerating
| weeks |
weeks := OrderedCollection new.
month weeksDo: [ :w | weeks add: w start ].
0 to: 4 do: [ :i | weeks remove: (Week starting: ('29 June 1998' asDate addDays: i * 7)) start ].
self assert: weeks isEmpty!
----- Method: MonthTest>>testInquiries (in category 'Tests') -----
testInquiries
self
assert: month index = 7;
assert: month name = #July;
assert: month duration = (31 days).
!
----- Method: MonthTest>>testInstanceCreation (in category 'Tests') -----
testInstanceCreation
| m1 m2 |
m1 := Month starting: '4 July 1998' asDate.
m2 := Month month: #July year: 1998.
self
assert: month = m1;
assert: month = m2!
----- Method: MonthTest>>testPreviousNext (in category 'Tests') -----
testPreviousNext
| n p |
n := month next.
p := month previous.
self
assert: n year = 1998;
assert: n index = 8;
assert: p year = 1998;
assert: p index = 6.
!
----- Method: MonthTest>>testPrinting (in category 'Tests') -----
testPrinting
self
assert: month printString = 'July 1998'.
!
----- Method: MonthTest>>testReadFrom (in category 'Tests') -----
testReadFrom
| m |
m := Month readFrom: 'July 1998' readStream.
self
assert: m = month!
ClassTestCase subclass: #NumberTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: NumberTest>>testPrintShowingDecimalPlaces (in category 'tests') -----
testPrintShowingDecimalPlaces
self assert: (111.2 printShowingDecimalPlaces: 2) = '111.20'.
self assert: (111.2 printShowingDecimalPlaces: 0) = '111'.
self assert: (111 printShowingDecimalPlaces: 0) = '111'.
self assert: (111111111111111 printShowingDecimalPlaces: 2) = '111111111111111.00'.
self assert: (10 printShowingDecimalPlaces: 20) ='10.00000000000000000000'.
!
----- Method: NumberTest>>testReadFrom (in category 'tests') -----
testReadFrom
self assert: 1.0e-14 = (Number readFrom: '1.0e-14').
self assert: 2r1e26 = (Number readFrom: '2r1e26').!
ClassTestCase subclass: #ObjectTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
----- Method: ObjectTest>>a (in category 'private') -----
a
self b.!
----- Method: ObjectTest>>a1 (in category 'private') -----
a1
self b1.!
----- Method: ObjectTest>>b (in category 'private') -----
b
self haltIf: #testHaltIf.!
----- Method: ObjectTest>>b1 (in category 'private') -----
b1
self haltIf: #testasdasdfHaltIf.!
----- Method: ObjectTest>>testAssert (in category 'tests - debugging') -----
testAssert
self shouldnt: [Object assert: [true]] raise: Error.
self shouldnt: [Object assert: true] raise: Error.
self should: [Object assert: [false]] raise: AssertionFailure.
self should: [Object assert: false] raise: AssertionFailure.!
----- Method: ObjectTest>>testBecome (in category 'tests') -----
testBecome
"self debug: #testBecome"
"this test should that all the variables pointing to an object are pointing now to another one, and all
object pointing to the other are pointing to the object"
| pt1 pt2 pt3 |
pt1 := 0 at 0.
pt2 := pt1.
pt3 := 100 at 100.
pt1 become: pt3.
self assert: pt2 = (100 at 100).
self assert: pt3 = (0 at 0).
self assert: pt1 = (100 at 100).!
----- Method: ObjectTest>>testBecomeForward (in category 'tests') -----
testBecomeForward
"self debug: #testBecomeForward"
"this test should that all the variables pointing to an object are pointing now to another one.
Not that this inverse is not true. This kind of become is called oneWayBecome in VW"
| pt1 pt2 pt3 |
pt1 := 0 at 0.
pt2 := pt1.
pt3 := 100 at 100.
pt1 becomeForward: pt3.
self assert: pt2 = (100 at 100).
self assert: pt3 == pt2.
self assert: pt1 = (100 at 100)!
----- Method: ObjectTest>>testHaltIf (in category 'tests - debugging') -----
testHaltIf
self should: [self haltIf: true] raise: Halt.
self shouldnt: [self haltIf: false] raise: Halt.
self should: [self haltIf: [true]] raise: Halt.
self shouldnt: [self haltIf: [false]] raise: Halt.
self should: [self haltIf: #testHaltIf.] raise: Halt.
self shouldnt: [self haltIf: #teadfasdfltIf.] raise: Halt.
self should: [self a] raise: Halt.
self shouldnt: [self a1] raise: Halt.
self should: [self haltIf: [:o | o class = self class]] raise: Halt.
self shouldnt: [self haltIf: [:o | o class ~= self class]] raise: Halt.
!
ClassTestCase subclass: #ProtoObjectTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
!ProtoObjectTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class ProtoObject. 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!
----- Method: ProtoObjectTest>>testFlag (in category 'testing - testing') -----
testFlag
self shouldnt: [ProtoObject new flag: #hallo] raise: Error.!
----- Method: ProtoObjectTest>>testIsNil (in category 'testing - testing') -----
testIsNil
self assert: (ProtoObject new isNil = false).!
ClassTestCase subclass: #RandomTest
instanceVariableNames: 'gen'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
----- Method: RandomTest>>setUp (in category 'setup') -----
setUp
gen := Random seed: 112629.!
----- Method: RandomTest>>testNext (in category 'tests') -----
testNext
10000 timesRepeat: [
| next |
next := gen next.
self assert: (next >= 0).
self assert: (next < 1).
].!
ClassTestCase subclass: #ScaledDecimalTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
!ScaledDecimalTest commentStamp: '<historical>' prior: 0!
I provide a test suite for ScaledDecimal values. Examine my tests to see how SmallIntegers should behave, and see how to use them.!
----- Method: ScaledDecimalTest>>testAsNumber (in category 'tests') -----
testAsNumber
"Ensure no loss of precision"
| sd |
sd := '1.40s2' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '1.40s2' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberNegatedWithoutDecimalPoint (in category 'tests') -----
testAsNumberNegatedWithoutDecimalPoint
| sd |
sd := '-123s0' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 0.
self assert: '-123s0' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberNegatedWithoutDecimalPoint2 (in category 'tests') -----
testAsNumberNegatedWithoutDecimalPoint2
| sd |
sd := '-123s2' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '-123.00s2' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberWithExtendedScale (in category 'tests') -----
testAsNumberWithExtendedScale
| sd |
sd := '123s2' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '123.00s2' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberWithRadix (in category 'tests') -----
testAsNumberWithRadix
| sd |
sd := '10r-22.2s5' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 5.
self assert: '-22.20000s5' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberWithSuperfluousDecimalPoint (in category 'tests') -----
testAsNumberWithSuperfluousDecimalPoint
| sd |
sd := '123.s2' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '123.00s2' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberWithoutDecimalPoint (in category 'tests') -----
testAsNumberWithoutDecimalPoint
| sd |
sd := '123s0' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 0.
self assert: '123s0' = sd printString.
!
----- Method: ScaledDecimalTest>>testAsNumberWithoutDecimalPoint2 (in category 'tests') -----
testAsNumberWithoutDecimalPoint2
| sd |
sd := '123s2' asNumber.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '123.00s2' = sd printString.
!
----- Method: ScaledDecimalTest>>testConvertFromFloat (in category 'tests') -----
testConvertFromFloat
| aFloat sd f2 diff |
aFloat := 11/13 asFloat.
sd := aFloat asScaledDecimal: 2.
self assert: 2 == sd scale.
self assert: '0.84s2' = sd printString.
f2 := sd asFloat.
diff := f2 - aFloat.
self assert: diff < 1.0e-9. "actually, f = f2, but this is not a requirement"
!
----- Method: ScaledDecimalTest>>testConvertFromFraction (in category 'tests') -----
testConvertFromFraction
| sd |
sd := (13 / 11) asScaledDecimal: 6.
self assert: ScaledDecimal == sd class.
self assert: ('1.181818s6' = sd printString).
self assert: 6 == sd scale
!
----- Method: ScaledDecimalTest>>testConvertFromInteger (in category 'tests') -----
testConvertFromInteger
"Converting an Integer to a ScaledDecimal yields a ScaledDecimal with
scale 0, regardless of the scale specified in the #asScaledDecimal: message."
| sd |
sd := 13 asScaledDecimal: 6.
self assert: 0 = sd scale.
self assert: ('13s0' = sd printString).
sd := -13 asScaledDecimal: 6.
self assert: 0 = sd scale.
self assert: ('-13s0' = sd printString).
sd := 130000000013 asScaledDecimal: 6.
self assert: 0 = sd scale.
self assert: ('130000000013s0' = sd printString).
sd := -130000000013 asScaledDecimal: 6.
self assert: 0 = sd scale.
self assert: ('-130000000013s0' = sd printString)
!
----- Method: ScaledDecimalTest>>testLiteral (in category 'tests') -----
testLiteral
| sd |
sd := 1.40s2.
self assert: ScaledDecimal == sd class.
self assert: sd scale == 2.
self assert: '1.40s2' = sd printString!
----- Method: ScaledDecimalTest>>testPrintString (in category 'tests') -----
testPrintString
"The printed representation of a ScaledDecimal is truncated, not rounded.
Not sure if this is right, so this test describes the current Squeak implementation.
If someone knows a reason that rounding would be preferable, then update
this test."
| sd |
sd := (13 / 11) asScaledDecimal: 6.
self assert: ('1.181818s6' = sd printString).
sd := (13 / 11) asScaledDecimal: 5.
self deny: ('1.18182s5' = sd printString).
sd := (13 / 11) asScaledDecimal: 5.
self assert: ('1.18181s5' = sd printString)
!
ClassTestCase subclass: #ScheduleTest
instanceVariableNames: 'firstEvent aSchedule restoredTimeZone'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: ScheduleTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Schedule
!
----- Method: ScheduleTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| private |
private := #( #printOn: ).
^ super selectorsToBeIgnored, private
!
----- Method: ScheduleTest>>setUp (in category 'running') -----
setUp
"Schedule is a type of Timespan representing repeated occurences of the same event.
The beginning of the schedule is the first occurrence of the event.
A schedule maintains an array of Durations.
Each durations specify the offset to the next scheduled each.
The duration of each occurence of the event is not specified.
Nor are any other attributes such as name"
restoredTimeZone := DateAndTime localTimeZone.
DateAndTime localTimeZone: (TimeZone timeZones detect: [:tz | tz abbreviation = 'GMT']).
"Create aSchedule with an event scheduled for 8:30pm every Saturday
and Sunday for the year 2003. "
"Create the first event occurring on the first Saturday at 8:30 pm: 1/4/03"
firstEvent := DateAndTime year: 2003 month: 1 day: 4 hour: 20 minute: 30.
"Create a schedule for one year starting with the first event"
aSchedule := Schedule starting: firstEvent duration: 52 weeks.
"Schedule the recurring events by scheduling the time in between each one.
One day for Sat-Sun. 6 days for Sun-Sat"
aSchedule schedule: { Duration days: 1. Duration days: 6 }.
!
----- Method: ScheduleTest>>tearDown (in category 'running') -----
tearDown
DateAndTime localTimeZone: restoredTimeZone.
!
----- Method: ScheduleTest>>testBetweenAndDoDisjointWithSchedule (in category 'testing') -----
testBetweenAndDoDisjointWithSchedule
| count |
count := 0.
aSchedule
between: (DateAndTime
year: 2004
month: 4
day: 1)
and: (DateAndTime
year: 2004
month: 4
day: 30)
do: [:each | count := count + 1].
self assert: count = 0!
----- Method: ScheduleTest>>testBetweenAndDoIncludedInSchedule (in category 'testing') -----
testBetweenAndDoIncludedInSchedule
| count |
count := 0.
aSchedule
between: (DateAndTime
year: 2003
month: 4
day: 1)
and: (DateAndTime
year: 2003
month: 4
day: 30)
do: [:each | count := count + 1].
self assert: count = 8!
----- Method: ScheduleTest>>testBetweenAndDoOverlappingSchedule (in category 'testing') -----
testBetweenAndDoOverlappingSchedule
| count |
count := 0.
aSchedule
between: (DateAndTime
year: 2002
month: 12
day: 1)
and: (DateAndTime
year: 2003
month: 1
day: 31)
do: [:each | count := count + 1].
self assert: count = 8!
----- Method: ScheduleTest>>testDateAndTimes (in category 'testing') -----
testDateAndTimes
| answer |
self assert: aSchedule dateAndTimes size = 104.
self assert: aSchedule dateAndTimes first = firstEvent.
answer := true.
aSchedule dateAndTimes do: [:each | (each dayOfWeekName = 'Saturday'
or: [each dayOfWeekName = 'Sunday']) ifFalse: [^false]].
self assert: answer
!
----- Method: ScheduleTest>>testExampleFromSwikiPage (in category 'testing') -----
testExampleFromSwikiPage
"It is often neccessary to schedule repeated events, like airline flight schedules, TV programmes, and file backups.
Schedule is a Timespan which maintains an array of Durations.
The durations specify the offset to the next scheduled DateAndTime. "
"Consider a TV programme scheduled for 8:30pm every Saturday and Sunday for the current year. "
"Find the first Saturday and set its time to 20h30"
| sat shows |
sat := Year current asMonth dates detect: [ :d | d dayOfWeekName = #Saturday ].
sat := sat start + (Duration hours: 20.5).
"Create a schedule"
shows := Schedule starting: sat ending: Year current end.
shows schedule: { Duration days: 1. Duration days: 6 }.
"To inspect:"
shows dateAndTimes.
shows dateAndTimes collect: [ :dt | dt dayOfWeekName ].
!
----- Method: ScheduleTest>>testFromDateAndTime (in category 'Tests') -----
testFromDateAndTime
| oc1 oc2 |
oc1 := OrderedCollection new.
DateAndTime today to: DateAndTime tomorrow by: 10 hours do: [ :dt | oc1 add: dt ].
oc2 := { DateAndTime today.
(DateAndTime today + 10 hours).
(DateAndTime today + 20 hours) }.
self assert: (oc1 asArray = oc2)!
----- Method: ScheduleTest>>testIncludes (in category 'testing') -----
testIncludes
self assert: (aSchedule includes: (DateAndTime year: 2003 month: 6 day: 15 hour: 20 minute: 30 second: 0 offset: 0 hours))
!
----- Method: ScheduleTest>>testMonotonicity (in category 'Tests') -----
testMonotonicity
| t1 t2 t3 t4 |
t1 := DateAndTime now.
t2 := DateAndTime now.
t3 := DateAndTime now.
t4 := DateAndTime now.
self
assert: ( t1 <= t2);
assert: ( t2 <= t3);
assert: ( t3 <= t4).
!
----- Method: ScheduleTest>>testSchedule (in category 'testing') -----
testSchedule
self assert: aSchedule schedule size = 2.
self assert: aSchedule schedule first = 1 days.
self assert: aSchedule schedule second = 6 days.
!
ClassTestCase subclass: #SemaphoreTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Processes'!
!SemaphoreTest commentStamp: 'tlk 5/5/2006 13:32' prior: 0!
A SemaphoreTest is sunit test for simple and multiEx semaphores
Instance Variables none; does not have common test fixture accross all tests (because its testing differenct sorts of semaphores (could refactor into muliple testcases if there were more test conditions.
!
----- Method: SemaphoreTest>>criticalError (in category 'private') -----
criticalError
Processor activeProcess terminate!
----- Method: SemaphoreTest>>testCritical (in category 'testing') -----
testCritical
| lock |
lock := Semaphore forMutualExclusion.
[lock critical: [self criticalError]] forkAt: Processor userInterruptPriority.
self assert: lock isSignaled!
----- Method: SemaphoreTest>>testCriticalIfError (in category 'testing') -----
testCriticalIfError
| lock |
lock := Semaphore forMutualExclusion.
[lock critical: [self criticalError ifError:[]]] forkAt: Processor userInterruptPriority.
self assert: lock isSignaled!
----- Method: SemaphoreTest>>testSemaAfterCriticalWait (in category 'testing') -----
testSemaAfterCriticalWait "self run: #testSemaAfterCriticalWait"
"This tests whether a semaphore that has just left the wait in Semaphore>>critical:
leaves it with signaling the associated semaphore."
| s p |
s := Semaphore new.
p := [s critical:[]] forkAt: Processor activePriority-1.
"wait until p entered the critical section"
[p suspendingList == s] whileFalse:[(Delay forMilliseconds: 10) wait].
"Now that p entered it, signal the semaphore. p now 'owns' the semaphore
but since we are running at higher priority than p it will not get to do
anything."
s signal.
p terminate.
self assert:[(s instVarNamed: #excessSignals) = 1]!
----- Method: SemaphoreTest>>testSemaInCriticalWait (in category 'testing') -----
testSemaInCriticalWait "self run: #testSemaInCriticalWait"
"This tests whether a semaphore that has entered the wait in Semaphore>>critical:
leaves it without signaling the associated semaphore."
| s p |
s := Semaphore new.
p := [s critical:[]] fork.
Processor yield.
self assert:[p suspendingList == s].
p terminate.
self assert:[(s instVarNamed: #excessSignals) = 0]!
----- Method: SemaphoreTest>>waitAndWaitTimeoutTogether (in category 'tests not working') -----
waitAndWaitTimeoutTogether
"self run: #testWaitAndWaitTimeoutTogether"
| semaphore value waitProcess waitTimeoutProcess |
self halt: 'WatchOut Hang the image'.
semaphore := Semaphore new.
waitProcess := [semaphore wait. value := #wait] fork.
waitTimeoutProcess := [semaphore waitTimeoutMSecs: 50. value := #waitTimeout] fork.
"Wait for the timeout to happen"
(Delay forMilliseconds: 100) wait.
"The waitTimeoutProcess should already have timed out. This should release the waitProcess"
semaphore signal.
[waitProcess isTerminated and: [waitTimeoutProcess isTerminated]]
whileFalse: [(Delay forMilliseconds: 100) wait].
self assert: value = #wait.
!
ClassTestCase subclass: #SmallIntegerTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
!SmallIntegerTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0!
I provide a test suite for SmallInteger values. Examine my tests to see how SmallIntegers should behave, and see how to use them.!
----- Method: SmallIntegerTest>>testBasicNew (in category 'testing - Class Methods') -----
testBasicNew
self should: [SmallInteger basicNew] raise: TestResult error. !
----- Method: SmallIntegerTest>>testDivide (in category 'testing - arithmetic') -----
testDivide
self assert: 2 / 1 = 2.
self assert: (3 / 2) isFraction.
self assert: 4 / 2 = 2.
self should: [ 1 / 0 ] raise: ZeroDivide.!
----- Method: SmallIntegerTest>>testMaxVal (in category 'testing - Class Methods') -----
testMaxVal
self assert: (SmallInteger maxVal = 16r3FFFFFFF).!
----- Method: SmallIntegerTest>>testMinVal (in category 'testing - Class Methods') -----
testMinVal
self assert: (SmallInteger minVal = -16r40000000).!
----- Method: SmallIntegerTest>>testNew (in category 'testing - Class Methods') -----
testNew
self should: [SmallInteger new] raise: TestResult error. !
----- Method: SmallIntegerTest>>testPrintPaddedWith (in category 'testing - printing') -----
testPrintPaddedWith
self assert: (123 printPaddedWith: $0 to: 10 base: 2) = '0001111011'.
self assert: (123 printPaddedWith: $0 to: 10 base: 8) = '0000000173'.
self assert: (123 printPaddedWith: $0 to: 10 base: 10) = '0000000123'.
self assert: (123 printPaddedWith: $0 to: 10 base: 16) = '000000007B'.!
----- Method: SmallIntegerTest>>testPrintString (in category 'testing - printing') -----
testPrintString
self assert: 1 printString = '1'.
self assert: -1 printString = '-1'.
self assert: SmallInteger minVal printString = '-1073741824'.
self assert: SmallInteger maxVal printString = '1073741823'.
self assert: 12345 printString = '12345'.
self assert: -54321 printString = '-54321'.
self assert: 0 decimalDigitLength = 1.
self assert: 4 decimalDigitLength = 1.
self assert: 12 decimalDigitLength = 2.
self assert: 123 decimalDigitLength = 3.
self assert: 1234 decimalDigitLength = 4.
self assert: 56789 decimalDigitLength = 5.
self assert: 657483 decimalDigitLength = 6.
self assert: 6571483 decimalDigitLength = 7.
self assert: 65174383 decimalDigitLength = 8.
self assert: 625744831 decimalDigitLength = 9.
self assert: 1000001111 decimalDigitLength = 10.
self assert: SmallInteger maxVal decimalDigitLength = 10.!
ClassTestCase subclass: #SqNumberParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Numbers'!
!SqNumberParserTest commentStamp: 'nice 5/7/2006 17:54' prior: 0!
Provide tests for new clas aimed at parsing numbers.
It duplicates NumberParsingTest, with few more tests.!
----- Method: SqNumberParserTest>>testFloatFromStreamAsNumber (in category 'tests - Float') -----
testFloatFromStreamAsNumber
"This covers parsing in Number>>readFrom:"
| rs aFloat |
rs := '10r-12.3456' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -12.3456 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456e2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456e2e2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -1234.56 = aFloat.
self assert: rs upToEnd = 'e2'.
rs := '10r-12.3456d2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '10r-12.3456q2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '-12.3456q2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: -1234.56 = aFloat.
self assert: rs atEnd.
rs := '12.3456q2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1234.56 = aFloat.
self assert: rs atEnd.
rs := '12.3456z2' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 12.3456 = aFloat.
self assert: rs upToEnd = 'z2'.
!
----- Method: SqNumberParserTest>>testFloatFromStreamWithExponent (in category 'tests - Float') -----
testFloatFromStreamWithExponent
"This covers parsing in Number>>readFrom:"
| rs aFloat |
rs := '1.0e-14' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs atEnd.
rs := '1.0e-14 1' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs upToEnd = ' 1'.
rs := '1.0e-14eee' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1.0e-14 = aFloat.
self assert: rs upToEnd = 'eee'.
rs := '1.0e14e10' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1.0e14 = aFloat.
self assert: rs upToEnd = 'e10'.
rs := '1.0e+14e' readStream. "Plus sign is not parseable"
aFloat := SqNumberParser parse: rs.
self assert: 1.0 = aFloat.
self assert: rs upToEnd = 'e+14e'.
rs := '1.0e' readStream.
aFloat := SqNumberParser parse: rs.
self assert: 1.0 = aFloat.
self assert: rs upToEnd = 'e'.!
----- Method: SqNumberParserTest>>testFloatPrintString (in category 'tests - Float') -----
testFloatPrintString
"self debug: #testFloatPrintString"
| f r |
f := Float basicNew: 2.
r := Random new seed: 1234567.
100
timesRepeat: [f basicAt: 1 put: (r nextInt: 16r100000000)- 1.
f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
#(2 8 10 16)
do: [:base | | str |
str := (String new: 64) writeStream.
f negative ifTrue: [str nextPut: $-].
str print: base; nextPut: $r.
f absPrintExactlyOn: str base: base.
self assert: (SqNumberParser parse: str contents) = f]].
"test big num near infinity"
10
timesRepeat: [f basicAt: 1 put: 16r7FE00000 + ((r nextInt: 16r100000) - 1).
f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
#(2 8 10 16)
do: [:base | | str |
str := (String new: 64) writeStream.
f negative ifTrue: [str nextPut: $-].
str print: base; nextPut: $r.
f absPrintExactlyOn: str base: base.
self assert: (SqNumberParser parse: str contents) = f]].
"test infinitesimal (gradual underflow)"
10
timesRepeat: [f basicAt: 1 put: 0 + ((r nextInt: 16r100000) - 1).
f basicAt: 2 put: (r nextInt: 16r100000000) - 1.
#(2 8 10 16)
do: [:base | | str |
str := (String new: 64) writeStream.
f negative ifTrue: [str nextPut: $-].
str print: base; nextPut: $r.
f absPrintExactlyOn: str base: base.
self assert: (SqNumberParser parse: str contents) = f]].!
----- Method: SqNumberParserTest>>testFloatReadError (in category 'tests - Float') -----
testFloatReadError
"This covers parsing in Number>>readFrom:"
| rs num |
rs := '1e' readStream.
num := SqNumberParser parse: rs.
self assert: 1 = num.
self assert: rs upToEnd = 'e'.
rs := '1s' readStream.
num := SqNumberParser parse: rs.
self assert: 1 = num.
self assert: rs upToEnd = 's'.
rs := '1.' readStream.
num := SqNumberParser parse: rs.
self assert: 1 = num.
self assert: num isInteger.
self assert: rs upToEnd = '.'.
rs := '' readStream.
self should: [SqNumberParser parse: rs] raise: Error.
rs := 'foo' readStream.
self should: [SqNumberParser parse: rs] raise: Error.
rs := 'radix' readStream.
self should: [SqNumberParser parse: rs] raise: Error.
rs := '.e0' readStream.
self should: [SqNumberParser parse: rs] raise: Error.
rs := '-.e0' readStream.
self should: [SqNumberParser parse: rs] raise: Error.
rs := '--1' readStream.
self should: [SqNumberParser parse: rs] raise: Error.!
----- Method: SqNumberParserTest>>testFloatReadWithRadix (in category 'tests - Float') -----
testFloatReadWithRadix
"This covers parsing in Number>>readFrom:
Note: In most Smalltalk dialects, the radix notation is not used for numbers
with exponents. In Squeak, a string with radix and exponent can be parsed,
and the exponent is always treated as base 10 (not the base indicated in the
radix prefix). I am not sure if this is a feature, a bug, or both, but the
Squeak behavior is documented in this test. -dtl"
| aNumber rs |
aNumber := '2r1.0101e9' asNumber.
self assert: 672.0 = aNumber.
self assert: (SqNumberParser parse: '2r1.0101e9') = (1.3125 * (2 raisedTo: 9)).
rs := '2r1.0101e9e9' readStream.
self assert: (SqNumberParser parse: rs) = 672.0.
self assert: rs upToEnd = 'e9'!
----- Method: SqNumberParserTest>>testIntegerReadFrom (in category 'tests - Integer') -----
testIntegerReadFrom
"Ensure remaining characters in a stream are not lost when parsing an integer."
| rs i s |
rs := '123s could be confused with a ScaledDecimal' readStream.
i := SqNumberParser parse: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: 's could be confused with a ScaledDecimal' = s.
rs := '123.s could be confused with a ScaledDecimal' readStream.
i := SqNumberParser parse: rs.
self assert: i == 123.
s := rs upToEnd.
self assert: '.s could be confused with a ScaledDecimal' = s!
----- Method: SqNumberParserTest>>testIntegerReadWithRadix (in category 'tests - Integer') -----
testIntegerReadWithRadix
"This covers parsing in Number>>readFrom:
Note: In most Smalltalk dialects, the radix notation is not used for numbers
with exponents. In Squeak, a string with radix and exponent can be parsed,
and the exponent is always treated as base 10 (not the base indicated in the
radix prefix). I am not sure if this is a feature, a bug, or both, but the
Squeak behavior is documented in this test. -dtl"
| aNumber rs |
aNumber := '2r1e26' asNumber.
self assert: 67108864 = aNumber.
self assert: (SqNumberParser parse: '2r1e26') = (2 raisedTo: 26).
rs := '2r1e26eee' readStream.
self assert: (SqNumberParser parse: rs) = 67108864.
self assert: rs upToEnd = 'eee'
!
ClassTestCase subclass: #StopwatchTest
instanceVariableNames: 'aStopwatch aDelay'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: StopwatchTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Stopwatch
!
----- Method: StopwatchTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| private |
private := #( #printOn: #state: ).
^ super selectorsToBeIgnored, private
!
----- Method: StopwatchTest>>setUp (in category 'running') -----
setUp
aStopwatch := Stopwatch new.
aDelay := Delay forMilliseconds: 1.!
----- Method: StopwatchTest>>testActive (in category 'Tests') -----
testActive
| sw |
sw := Stopwatch new.
sw activate.
1 seconds asDelay wait.
self
assert: (sw duration >= 1 seconds).
2 seconds asDelay wait.
self
assert: (sw duration >= 3 seconds).
sw suspend.!
----- Method: StopwatchTest>>testChangingStatus (in category 'testing') -----
testChangingStatus
aStopwatch activate.
self assert: aStopwatch isActive.
self assert: aStopwatch timespans size = 1.
aStopwatch suspend.
self assert: aStopwatch isSuspended.
self assert: aStopwatch timespans size = 1.
aStopwatch activate.
aStopwatch reActivate.
self assert: aStopwatch isActive.
self assert: aStopwatch timespans size = 3.
aStopwatch reset.
self assert: aStopwatch isSuspended.
self assert: aStopwatch timespans size = 0.!
----- Method: StopwatchTest>>testInitialStatus (in category 'testing') -----
testInitialStatus
self assert: aStopwatch isSuspended.
self deny: aStopwatch isActive.
self assert: aStopwatch duration = 0 seconds!
----- Method: StopwatchTest>>testMultipleTimings (in category 'testing') -----
testMultipleTimings
aStopwatch activate.
aDelay wait.
aStopwatch suspend.
aStopwatch activate.
aDelay wait.
aStopwatch suspend.
self assert: aStopwatch timespans size = 2.
self assert: aStopwatch timespans first asDateAndTime <=
aStopwatch timespans last asDateAndTime.
!
----- Method: StopwatchTest>>testNew (in category 'Tests') -----
testNew
| sw |
sw := Stopwatch new.
self
assert: (sw isSuspended);
assert: (sw state = #suspended);
deny: (sw isActive);
assert: (sw timespans isEmpty)
!
----- Method: StopwatchTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := 'a Stopwatch(suspended:0:00:00:00)' readStream.
rw := ReadWriteStream on: ''.
aStopwatch printOn: rw.
self assert: rw contents = cs contents!
----- Method: StopwatchTest>>testReActivate (in category 'Tests') -----
testReActivate
| sw |
sw := Stopwatch new.
sw
activate;
suspend;
reActivate.
self
assert: (sw isActive).
!
----- Method: StopwatchTest>>testReset (in category 'Tests') -----
testReset
| sw |
sw := Stopwatch new.
sw activate.
sw reset.
self
assert: (sw isSuspended);
assert: (sw timespans isEmpty)
!
----- Method: StopwatchTest>>testSingleTiming (in category 'testing') -----
testSingleTiming
| timeBefore |
timeBefore := DateAndTime now.
aStopwatch activate.
aDelay wait.
aStopwatch suspend.
self assert: aStopwatch timespans size = 1.
self assert: aStopwatch timespans first asDateAndTime >= timeBefore.
self assert: aStopwatch timespans first asDateAndTime <= aStopwatch end.
!
----- Method: StopwatchTest>>testStartStop (in category 'Tests') -----
testStartStop
| sw t1 t2 t3 t4 |
sw := Stopwatch new.
t1 := DateAndTime now.
(Delay forMilliseconds: 10) wait.
sw activate; activate.
(Delay forMilliseconds: 10) wait.
t2 := DateAndTime now.
self
deny: (sw isSuspended);
assert: (sw isActive);
assert: (sw timespans size = 1);
assert: (t1 <= sw start);
assert: (sw start <= t2).
(Delay forMilliseconds: 10) wait.
t3 := DateAndTime now.
(Delay forMilliseconds: 10) wait.
sw suspend; suspend.
(Delay forMilliseconds: 10) wait.
t4 := DateAndTime now.
self
assert: (sw isSuspended);
deny: (sw isActive);
assert: (sw timespans size = 1);
assert: (sw end between: t3 and: t4);
assert: (t3 <= sw end);
assert: (sw end <= t4).
!
ClassTestCase subclass: #TimeStampTest
instanceVariableNames: 'timestamp aTimeStamp'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!TimeStampTest commentStamp: 'brp 7/26/2003 22:44' prior: 0!
This is the unit test for the class TimeStamp.!
----- Method: TimeStampTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ self timestampClass!
----- Method: TimeStampTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| deprecated private special |
deprecated := #().
private := #( #printOn: ).
special := #().
^ super selectorsToBeIgnored, deprecated, private, special.!
----- Method: TimeStampTest>>setUp (in category 'Running') -----
setUp
timestamp := self timestampClass date: ('1-10-2000' asDate) time: ('11:55:00 am' asTime).
aTimeStamp := TimeStamp readFrom: '1-02-2004 12:34:56 am' readStream!
----- Method: TimeStampTest>>tearDown (in category 'Running') -----
tearDown
timestamp := nil.!
----- Method: TimeStampTest>>testAccessing (in category 'Tests') -----
testAccessing
| d t |
d := '1-10-2000' asDate.
t := '11:55:00 am' asTime.
self
assert: timestamp date = d;
assert: timestamp time = t.
!
----- Method: TimeStampTest>>testArithmetic (in category 'Tests') -----
testArithmetic
| ts |
ts := timestamp minusDays: 123. "9 September 1999, 11:55 am"
ts := ts minusSeconds: 1056. "9 September 1999, 11:37:24 am"
ts := ts plusDays: 123. "10 January 2000, 11:37:24 am"
ts := ts plusSeconds: 1056. "10 January 2000, 11:55 am"
self
assert: ts = timestamp.
!
----- Method: TimeStampTest>>testArithmeticAcrossDateBoundary (in category 'Tests') -----
testArithmeticAcrossDateBoundary
| ts |
ts := timestamp minusSeconds: ((11*3600) + (55*60) + 1).
self
assert: ts = ('1-9-2000 11:59:59 pm' asTimeStamp).
!
----- Method: TimeStampTest>>testComparing (in category 'Tests') -----
testComparing
| ts1 ts2 ts3 c1 c2 le |
ts1 := self timestampClass date: ('01-10-2000' asDate) time: ('11:55:00 am' asTime).
ts2 := self timestampClass date: ('07-26-2003' asDate) time: ('22:09:45 am' asTime).
ts3 := self timestampClass date: ('05-28-1972' asDate) time: ('04:31:14 pm' asTime).
self
assert: ts1 = timestamp;
assert: ts1 hash = timestamp hash;
assert: timestamp = timestamp copy;
assert: ts1 < ts2;
deny: ts1 < ts3.
c1 := self timestampClass current.
c2 := self timestampClass current.
le := (c1 <= c2).
self assert: le.
!
----- Method: TimeStampTest>>testConverting (in category 'Tests') -----
testConverting
| d t |
d := '1-10-2000' asDate.
t := '11:55:00 am' asTime.
self
assert: timestamp asSeconds = (d asSeconds + t asSeconds);
assert: timestamp asDate = d;
assert: timestamp asTime = t;
assert: timestamp asTimeStamp == timestamp;
assert: timestamp dateAndTime = {d. t}.
!
----- Method: TimeStampTest>>testDate (in category 'testing') -----
testDate
self assert: aTimeStamp date = '01-02-2004' asDate!
----- Method: TimeStampTest>>testDateAndTime (in category 'testing') -----
testDateAndTime
self assert: aTimeStamp dateAndTime
= (Array with: '01-02-2004' asDate with: '00:34:56' asTime)!
----- Method: TimeStampTest>>testFromSeconds (in category 'Tests') -----
testFromSeconds
self
assert: (self timestampClass fromSeconds: 3124958100) = timestamp.!
----- Method: TimeStampTest>>testFromString (in category 'Tests') -----
testFromString
"This should signal an exception in 3.6beta as Time>>fromString: does not exist."
self should: [ timestamp = (self timestampClass fromString: '1-10-2000 11:55:00 am') ]
!
----- Method: TimeStampTest>>testInstanceCreation (in category 'Tests') -----
testInstanceCreation
self
should: [ self timestampClass midnight asDuration = (0 hours) ];
should: [ self timestampClass noon asDuration = (12 hours) ].
!
----- Method: TimeStampTest>>testMinusDays (in category 'testing') -----
testMinusDays
self assert: (aTimeStamp minusDays: 5) dateAndTime
= (Array with: '12-28-2003' asDate with: '00:34:56' asTime)!
----- Method: TimeStampTest>>testMinusSeconds (in category 'testing') -----
testMinusSeconds
self assert: (aTimeStamp minusSeconds: 34 * 60 + 56) dateAndTime
= (Array with: '01-02-2004' asDate with: '00:00:00' asTime)!
----- Method: TimeStampTest>>testMinusSecondsOverMidnight (in category 'testing') -----
testMinusSecondsOverMidnight
self assert: (aTimeStamp minusSeconds: 34 * 60 + 57) dateAndTime
= (Array with: '01-01-2004' asDate with: '23:59:59' asTime)
"Bug The results are actual results are: #(1 January 2005 11:25:03 pm)"!
----- Method: TimeStampTest>>testPlusDays (in category 'testing') -----
testPlusDays
self assert: (aTimeStamp plusDays: 366) dateAndTime
= (Array with: '01-02-2005' asDate with: '00:34:56' asTime)!
----- Method: TimeStampTest>>testPlusSeconds (in category 'testing') -----
testPlusSeconds
self assert: (aTimeStamp plusSeconds: 60 * 60 ) dateAndTime
= (Array with: '01-02-2004' asDate with: '01:34:56' asTime)!
----- Method: TimeStampTest>>testPlusSecondsOverMidnight (in category 'testing') -----
testPlusSecondsOverMidnight
self assert: (aTimeStamp plusSeconds: 24 * 60 * 60 + 1) dateAndTime
= (Array with: '01-03-2004' asDate with: '00:34:57' asTime)!
----- Method: TimeStampTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '2 January 2004 12:34:56 am' readStream.
rw := ReadWriteStream on: ''.
aTimeStamp printOn: rw.
self assert: rw contents = cs contents!
----- Method: TimeStampTest>>testPrinting (in category 'Tests') -----
testPrinting
self
assert: timestamp printString = '10 January 2000 11:55 am'.
!
----- Method: TimeStampTest>>testReadFromA1 (in category 'testing') -----
testReadFromA1
|ts|
ts := TimeStamp current.
self assert: (ts = (TimeStamp fromString: ts asString)).!
----- Method: TimeStampTest>>testSorting (in category 'Tests') -----
testSorting
| c1 c2 |
c1 := self timestampClass current.
c2 := self timestampClass current.
self
assert: (self timestampClass current) <= (self timestampClass current);
assert: (c1 <= c2).
!
----- Method: TimeStampTest>>testStoreOn (in category 'testing') -----
testStoreOn
| cs rw |
cs := '''2 January 2004 12:34:56 am'' asTimeStamp' readStream.
rw := ReadWriteStream on: ''.
aTimeStamp storeOn: rw.
self assert: rw contents = cs contents!
----- Method: TimeStampTest>>testTime (in category 'testing') -----
testTime
self assert: aTimeStamp time = '00:34:56' asTime!
----- Method: TimeStampTest>>testTimeStamp (in category 'testing') -----
testTimeStamp
self assert: aTimeStamp = aTimeStamp asTimeStamp
!
----- Method: TimeStampTest>>timestampClass (in category 'Private') -----
timestampClass
^ TimeStamp!
ClassTestCase subclass: #TimeTest
instanceVariableNames: 'time aTime localTimeZoneToRestore'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
!TimeTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Time.
!
----- Method: TimeTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ self timeClass!
----- Method: TimeTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| deprecated private special primitives timing benchmarks |
deprecated := #().
private := #( #print24:on: #print24:showSeconds:on: ).
special := #( #< #= #new #printOn: #storeOn: ).
primitives := #( #primMillisecondClock #primSecondsClock ).
timing := #( #millisecondClockValue #milliseconds:since: #millisecondsSince: ).
benchmarks := #( #benchmarkMillisecondClock #benchmarkPrimitiveResponseDelay ).
^ super selectorsToBeIgnored, deprecated, private, special, primitives, timing, benchmarks.!
----- Method: TimeTest>>setUp (in category 'Running') -----
setUp
localTimeZoneToRestore := DateAndTime localTimeZone.
DateAndTime localTimeZone: TimeZone default.
time := self timeClass fromSeconds: 14567. "4:02:47 am"
aTime := Time readFrom: '12:34:56 pm' readStream
!
----- Method: TimeTest>>tearDown (in category 'Running') -----
tearDown
DateAndTime localTimeZone: localTimeZoneToRestore.
!
----- Method: TimeTest>>testAccessing (in category 'Tests') -----
testAccessing
self
assert: time hours = 4;
assert: time minutes = 2;
assert: time seconds = 47;
assert: time asSeconds = 14567.
!
----- Method: TimeTest>>testAddSeconds (in category 'testing') -----
testAddSeconds
self assert: (aTime addSeconds: 1) = (Time readFrom: '12:34:57' readStream).
self assert: (aTime addSeconds: 60) = (Time readFrom: '12:35:56' readStream).
self assert: (aTime addSeconds: 3600) = (Time readFrom: '13:34:56' readStream).
self assert: (aTime addSeconds: 24 * 60 * 60) = (Time readFrom: '12:34:56' readStream)!
----- Method: TimeTest>>testAddTime (in category 'testing') -----
testAddTime
self assert: (aTime addTime: aTime) = (Time readFrom: '01:09:52' readStream)!
----- Method: TimeTest>>testArithmetic (in category 'Tests') -----
testArithmetic
| t1 t2 t3 |
t1 := time addSeconds: 70. "4:03:57 am"
self
assert: t1 hours = 4;
assert: t1 minutes = 3;
assert: t1 seconds = 57.
t2 := t1 addTime: (self timeClass fromSeconds: (60*60*5)).
self
assert: t2 hours = 9;
assert: t2 minutes = 3;
assert: t2 seconds = 57.
t3 := t2 subtractTime: (self timeClass fromSeconds: (60*60*5) + 70).
self
assert: t3 = time.
!
----- Method: TimeTest>>testAsDate (in category 'testing') -----
testAsDate
self assert: (aTime asDate) = (Date current)
!
----- Method: TimeTest>>testAsDateAndTime (in category 'testing') -----
testAsDateAndTime
self assert: (aTime asDateAndTime) = (DateAndTime current midnight + aTime)
!
----- Method: TimeTest>>testAsDuration (in category 'testing') -----
testAsDuration
self assert: (aTime asDuration) = (Duration days: 0 hours: 12 minutes: 34 seconds: 56)
!
----- Method: TimeTest>>testAsNanoSeconds (in category 'testing') -----
testAsNanoSeconds
self assert: (aTime asNanoSeconds) = 45296000000000
!
----- Method: TimeTest>>testAsSeconds (in category 'testing') -----
testAsSeconds
self assert: (aTime asSeconds) = 45296
!
----- Method: TimeTest>>testAsTime (in category 'testing') -----
testAsTime
self assert: (aTime asTime) = aTime
!
----- Method: TimeTest>>testAsTimeStamp (in category 'testing') -----
testAsTimeStamp
self assert: (aTime asTimeStamp) = (DateAndTime current midnight + aTime) asTimeStamp
!
----- Method: TimeTest>>testAsWeek (in category 'testing') -----
testAsWeek
self assert: aTime asWeek = (DateAndTime current midnight + aTime) asWeek
!
----- Method: TimeTest>>testAsYear (in category 'testing') -----
testAsYear
self assert: aTime asYear = (DateAndTime current midnight + aTime) asYear
!
----- Method: TimeTest>>testComparing (in category 'Tests') -----
testComparing
| t1 t2 t3 |
t1 := self timeClass fromSeconds: 14567. "4:02:47 am"
t2 := self timeClass fromSeconds: 5000. "1:23:20 am"
t3 := self timeClass fromSeconds: 80000. "10:13:20 pm"
self
assert: time = t1;
assert: time hash = t1 hash;
assert: time = time copy.
self
deny: t1 < t2;
assert: t1 < t3.!
----- Method: TimeTest>>testConverting (in category 'Tests') -----
testConverting
self
assert: time asSeconds = 14567.!
----- Method: TimeTest>>testDuration (in category 'testing') -----
testDuration
self assert: aTime duration = 0 seconds!
----- Method: TimeTest>>testEqual (in category 'testing') -----
testEqual
self assert: aTime = (Time readFrom: '12:34:56' readStream)!
----- Method: TimeTest>>testFromSeconds (in category 'Tests') -----
testFromSeconds
| t |
t := self timeClass fromSeconds: 14567.
self
assert: t = time
!
----- Method: TimeTest>>testGeneralInquiries (in category 'Tests') -----
testGeneralInquiries
| now d t dt |
now := self timeClass dateAndTimeNow.
self
assert: now size = 2;
assert: now last <= self timeClass now.
self should: [ self timeClass timeWords ] raise: MessageNotUnderstood.
d := '2 June 1973' asDate.
t := '4:02:47 am' asTime.
dt := self timeClass dateAndTimeFromSeconds: (2285280000 + 14567).
self
assert: dt = {d. t.}.
!
----- Method: TimeTest>>testHhmm24 (in category 'testing') -----
testHhmm24
self assert: aTime hhmm24 = '1234'!
----- Method: TimeTest>>testHour (in category 'testing') -----
testHour
self assert: aTime hour = 12.
self assert: aTime hour12 = 12.
self assert: aTime hour24 = 12.
self assert: aTime hours = 12.!
----- Method: TimeTest>>testHumanWordsForSecondsAgo (in category 'testing') -----
testHumanWordsForSecondsAgo
self assert: (Time humanWordsForSecondsAgo: 0.999999999)
= 'a second ago'.
self assert: (Time humanWordsForSecondsAgo: 44.99999999)
= '44.99999999 seconds ago'.
self assert: (Time humanWordsForSecondsAgo: 89.999999999)
= 'a minute ago'.
self assert: (Time humanWordsForSecondsAgo: 2699.999999999)
= '44 minutes ago'.
self assert: (Time humanWordsForSecondsAgo: 5399.999999999)
= 'an hour ago'.
self assert: (Time humanWordsForSecondsAgo: 64799.999999999)
= '17 hours ago'.
!
----- Method: TimeTest>>testHumanWordsForSecondsAgoWithDays (in category 'testing') -----
testHumanWordsForSecondsAgoWithDays
self assert: (Time humanWordsForSecondsAgo: 18 * 60 * 60)
= 'yesterday'.
self assert: (Time humanWordsForSecondsAgo: 24 * 60 * 60)
= 'yesterday'.
!
----- Method: TimeTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aTime < (Time readFrom: '12:34:57' readStream)!
----- Method: TimeTest>>testMeridianAbbreviation (in category 'testing') -----
testMeridianAbbreviation
self assert: aTime meridianAbbreviation = 'PM'.
!
----- Method: TimeTest>>testMinute (in category 'testing') -----
testMinute
self assert: aTime minute = 34.
self assert: aTime minutes = 34
!
----- Method: TimeTest>>testNanoSecond (in category 'testing') -----
testNanoSecond
self assert: aTime nanoSecond = 0
"Right now all times all seconds"
!
----- Method: TimeTest>>testNew (in category 'Tests') -----
testNew
self assert: self timeClass new asSeconds = 0!
----- Method: TimeTest>>testPrint24 (in category 'testing') -----
testPrint24
self assert: aTime print24 = '12:34:56'!
----- Method: TimeTest>>testPrint24On (in category 'testing') -----
testPrint24On
| cs rw |
cs := '12:34:56' readStream.
rw := ReadWriteStream on: ''.
aTime
print24: true
on: rw.
self assert: rw contents = cs contents!
----- Method: TimeTest>>testPrint24OnWithPM (in category 'testing') -----
testPrint24OnWithPM
| cs rw |
cs := '12:34:56 pm' readStream.
rw := ReadWriteStream on: ''.
aTime
print24: false
on: rw.
^ self assert: rw contents = cs contents!
----- Method: TimeTest>>testPrint24OnWithoutSeconds (in category 'testing') -----
testPrint24OnWithoutSeconds
| cs rw |
cs := '12:34:56' readStream.
rw := ReadWriteStream on: ''.
aTime
print24: true
showSeconds: true
on: rw.
self assert: rw contents = cs contents!
----- Method: TimeTest>>testPrintMinutes (in category 'testing') -----
testPrintMinutes
self assert: aTime printMinutes = '12:34 pm'!
----- Method: TimeTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := '12:34:56 pm' readStream.
rw := ReadWriteStream on: ''.
aTime printOn: rw.
self assert: rw contents = cs contents!
----- Method: TimeTest>>testPrinting (in category 'Tests') -----
testPrinting
self
assert: time printString = '4:02:47 am';
assert: time intervalString = '4 hours 2 minutes 47 seconds';
assert: time print24 = '04:02:47';
assert: time printMinutes = '4:02 am';
assert: time hhmm24 = '0402'.
!
----- Method: TimeTest>>testReadFrom (in category 'Tests') -----
testReadFrom
| string t |
string := '4:02:47 am'.
t := self timeClass readFrom: string readStream.
self
assert: time = t.
!
----- Method: TimeTest>>testSecond (in category 'testing') -----
testSecond
self assert: aTime second = 56.
self assert: aTime seconds = 56
!
----- Method: TimeTest>>testSqueakInquiries (in category 'Tests') -----
testSqueakInquiries
| timewords totalseconds condensed corrected |
self assert:
(self timeClass namesForTimes: #(2 10000023 10000026))
= #('January, 1901' 'April, 1901, 4/26/1901, 5:47 pm' 'April, 1901, 4/26/1901, 5:47 pm').
timewords := #(0.5 30 62 130 4000 10000 60000 90000)
collect: [ :ss | self timeClass humanWordsForSecondsAgo: ss ].
self assert:
timewords = #('a second ago' '30 seconds ago' 'a minute ago' '2 minutes ago'
'an hour ago' '2 hours ago' '16 hours ago' 'yesterday').
totalseconds := self timeClass totalSeconds.
condensed := self timeClass condenseBunches:
(#(20 400 401 20000 20200 20300 40000 45000 200000 201000 202000)
collect: [:tt | totalseconds - tt]).
corrected := condensed collect: [ :e | totalseconds - e ].
self
assert: (corrected includesAllOf: #(20 400 401 20000 40000 45000 200000)).
!
----- Method: TimeTest>>testStoreOn (in category 'testing') -----
testStoreOn
| cs rw |
cs := '''12:34:56 pm'' asTime' readStream.
rw := ReadWriteStream on: ''.
aTime storeOn: rw.
self assert: rw contents = cs contents!
----- Method: TimeTest>>testStoring (in category 'Tests') -----
testStoring
self
assert: time storeString = '''4:02:47 am'' asTime';
assert: time = ('4:02:47 am' asTime).
!
----- Method: TimeTest>>testSubtractTime (in category 'testing') -----
testSubtractTime
self assert: (aTime subtractTime: aTime) = (Time readFrom: '00:00:00' readStream)!
----- Method: TimeTest>>testTicks (in category 'testing') -----
testTicks
self assert: aTime ticks = #(0 45296 0).
self assert: aTime = (Time new ticks: #(0 45296 0))!
----- Method: TimeTest>>testTimeStamp (in category 'testing') -----
testTimeStamp
self assert: aTime = aTime asTimeStamp asTime!
----- Method: TimeTest>>timeClass (in category 'Private') -----
timeClass
^ Time!
ClassTestCase subclass: #TimespanTest
instanceVariableNames: 'timespan aTimespan anOverlappingTimespan anIncludedTimespan aDisjointTimespan aDay aWeek dec31 jan01 jan08 localTimeZoneToRestore'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: TimespanTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Timespan
!
----- Method: TimespanTest>>setUp (in category 'Running') -----
setUp
localTimeZoneToRestore := DateAndTime localTimeZone.
DateAndTime localTimeZone: TimeZone default.
"100 hours starting noon 22 March 2003"
timespan := Timespan starting:
(DateAndTime year: 2003 month: 03 day: 22 hour: 12 minute: 0 second: 0)
duration: (Duration hours: 100).
dec31 := (DateAndTime year: 2004 month: 12 day: 31 hour: 0 minute: 0 second: 0).
jan01 := (DateAndTime year: 2005 month: 1 day: 1 hour: 0 minute: 0 second: 0).
jan08 := (DateAndTime year: 2005 month: 1 day: 8 hour: 0 minute: 0 second:0).
aDay := Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.
aWeek := Duration days: 7 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0.
aTimespan := Timespan starting: jan01 duration: aWeek.
anOverlappingTimespan := Timespan starting: dec31 duration: aWeek.
anIncludedTimespan := Timespan starting: jan01 duration: aDay.
aDisjointTimespan := Timespan starting: jan08 duration: aWeek.
!
----- Method: TimespanTest>>tearDown (in category 'Running') -----
tearDown
DateAndTime localTimeZone: localTimeZoneToRestore.
timespan := nil
!
----- Method: TimespanTest>>testAccessing (in category 'Tests') -----
testAccessing
self
assert: (timespan start =
(DateAndTime year: 2003 month: 03 day: 22 hour: 12 minute: 0 second: 0));
assert: timespan duration = (Duration hours: 100);
assert: timespan month = 3;
assert: timespan monthName = 'March';
assert: timespan monthAbbreviation = 'Mar'
!
----- Method: TimespanTest>>testArithmetic (in category 'Tests') -----
testArithmetic
| ts1 ts2 d |
ts1 := timespan + 2 days.
ts2 := ts1 - 2 days.
d := ts1 - (DateAndTime year: 2003 month: 03 day: 20).
self
assert: (ts1 start =
(DateAndTime year: 2003 month: 03 day: 24 hour: 12 minute: 0 second: 0));
assert: (ts1 duration = timespan duration);
assert: (ts2 start = timespan start);
assert: (ts2 duration = timespan duration).
self
assert: d = (Duration days: 4 hours: 12 minutes: 0 seconds: 0)
!
----- Method: TimespanTest>>testAsDate (in category 'testing') -----
testAsDate
self assert: aTimespan asDate = jan01 asDate.
"MessageNotUnderstood: Date class>>starting:"
!
----- Method: TimespanTest>>testAsDateAndTime (in category 'testing') -----
testAsDateAndTime
self assert: aTimespan asDateAndTime = jan01.
"MessageNotUnderstood: Date class>>starting:"
!
----- Method: TimespanTest>>testAsDuration (in category 'testing') -----
testAsDuration
self assert: aTimespan asDuration = aWeek.
!
----- Method: TimespanTest>>testAsMonth (in category 'testing') -----
testAsMonth
self assert: aTimespan asMonth = jan01 asMonth.
!
----- Method: TimespanTest>>testAsTime (in category 'testing') -----
testAsTime
self assert: aTimespan asTime = jan01 asTime
"MessageNotUnderstood: Time class>>seconds:nanoSeconds:"
!
----- Method: TimespanTest>>testAsTimeStamp (in category 'testing') -----
testAsTimeStamp
self assert: aTimespan asTimeStamp = ((TimeStamp readFrom: '1-01-2005 0:00 am' readStream) offset: 0 hours).
!
----- Method: TimespanTest>>testAsWeek (in category 'testing') -----
testAsWeek
self assert: aTimespan asWeek = jan01 asWeek.
"DateAndTime new asWeek
MessageNotUnderstood: Week class>>starting:"
!
----- Method: TimespanTest>>testAsYear (in category 'testing') -----
testAsYear
self assert: aTimespan asYear = jan01 asYear.
!
----- Method: TimespanTest>>testClockPrecisionDuration (in category 'testing') -----
testClockPrecisionDuration
| ts |
ts := Timespan starting: Date today duration: DateAndTime clockPrecision.
self
assert: ts start = ts end!
----- Method: TimespanTest>>testCurrent (in category 'testing') -----
testCurrent
self assert: (Timespan starting: DateAndTime current)
<= Timespan current.
self assert: Timespan current
<= (Timespan starting: DateAndTime current)!
----- Method: TimespanTest>>testDay (in category 'testing') -----
testDay
self assert: aTimespan day = jan01 day
!
----- Method: TimespanTest>>testDayOfMonth (in category 'testing') -----
testDayOfMonth
self assert: aTimespan dayOfMonth = 1.
!
----- Method: TimespanTest>>testDayOfWeek (in category 'testing') -----
testDayOfWeek
self assert: aTimespan dayOfWeek = 7.
self assert: aTimespan dayOfWeekName = 'Saturday'.
!
----- Method: TimespanTest>>testDayOfYear (in category 'testing') -----
testDayOfYear
self assert: aTimespan dayOfYear = 1.
"MessageNotUnderstood: UndefinedObject>>year:, Undefined object is Year class"
!
----- Method: TimespanTest>>testDaysInMonth (in category 'testing') -----
testDaysInMonth
self assert: aTimespan daysInMonth = 31.
"MessageNotUnderstood: Month class>>starting:"
!
----- Method: TimespanTest>>testDaysInYear (in category 'testing') -----
testDaysInYear
self assert: aTimespan daysInYear = 365.
"MessageNotUnderstood: UndefinedObject>>starting: UndefinedObject is Year class"
!
----- Method: TimespanTest>>testDaysLeftInYear (in category 'testing') -----
testDaysLeftInYear
self assert: aTimespan daysLeftInYear = 364.
"MessageNotUnderstood: UndefinedObject>>starting: UndefinedObject is Year class"
!
----- Method: TimespanTest>>testDoWith (in category 'testing') -----
testDoWith
| count |
count := 0.
aTimespan
do: [:each | count := count + 1]
with: (Timespan starting: jan01 duration: aDay).
self assert: count = 7!
----- Method: TimespanTest>>testDoWithWhen (in category 'testing') -----
testDoWithWhen
| count |
count := 0.
aTimespan
do: [:each | count := count + 1]
with: (Timespan starting: jan01 duration: aDay)
when: [:each | count < 5].
self assert: count = 5!
----- Method: TimespanTest>>testDuration (in category 'testing') -----
testDuration
self assert: aTimespan duration = aWeek.
aTimespan duration: aDay.
self assert: aTimespan duration = aDay.
!
----- Method: TimespanTest>>testEnd (in category 'testing') -----
testEnd
self assert: aTimespan end + (Duration nanoSeconds:1) = aDisjointTimespan
"self assert: aTimespan end (DateAndTime year: 2005 month: 1 day: 7 hour: 23 minute: 59 second: 59 nanoSecond: 999999999 offset: 0 hours). "
"This should work once DateAndTime >> year:month:day:hour:minute:second:nanoSecond:offset: is fixed"
!
----- Method: TimespanTest>>testEveryDo (in category 'testing') -----
testEveryDo
| count duration |
count := 0.
duration := 7 days.
aTimespan
every: duration
do: [:each | count := count + 1].
self assert: count = 1!
----- Method: TimespanTest>>testFirstDayOfMonth (in category 'testing') -----
testFirstDayOfMonth
self assert: aTimespan firstDayOfMonth = 1.
self assert: aDisjointTimespan firstDayOfMonth = 1
!
----- Method: TimespanTest>>testIncludes (in category 'testing') -----
testIncludes
self assert: (aTimespan includes: jan01).
self deny: (aTimespan includes: jan08)
!
----- Method: TimespanTest>>testIncludesAllOf (in category 'testing') -----
testIncludesAllOf
self assert: (aTimespan includesAllOf: (Bag with: jan01)).
self deny: (aTimespan includesAllOf: (Bag with: jan01 with: jan08))
!
----- Method: TimespanTest>>testIncludesAnyOf (in category 'testing') -----
testIncludesAnyOf
self deny: (aTimespan includesAnyOf: (Bag with: dec31)).
self assert: (aTimespan includesAnyOf: (Bag with: jan01 with: jan08))
"Error is due to bug in Timespan
includesAnyOf: aCollection "
"Answer whether any element of aCollection is included in the receiver"
"aCollection do: [ :elem | (self includes: elem) ifTrue: [^ true]].
Shouldn't this return false if none are included?
"
!
----- Method: TimespanTest>>testInclusion (in category 'Tests') -----
testInclusion
| t1 t2 t3 t4 |
t1 := timespan start.
t2 := timespan start + (timespan duration / 2).
t3 := timespan end.
t4 := timespan start + (timespan duration).
self
assert: (timespan includes: t1);
assert: (timespan includes: t2);
assert: (timespan includes: t3)";
deny: (timespan includes: t4).
self
assert: (timespan includes: (t1 to: t2));
assert: (timespan includes: (t1 to: t4));
deny: (timespan includes: (Timespan starting: t2 duration: (timespan duration * 2))).
self
assert: (timespan includesAllOf: { t1. t2. t3 } );
deny: (timespan includesAllOf: { t1. t2. t3. t4} ).
self
assert: (timespan includesAnyOf: { t1. t2. t3 } );
deny: (timespan includesAnyOf: { t4 } ).
"!
----- Method: TimespanTest>>testIntersectionWithDisjoint (in category 'testing') -----
testIntersectionWithDisjoint
self assert: (aTimespan intersection: aDisjointTimespan) isNil.
!
----- Method: TimespanTest>>testIntersectionWithIncluded (in category 'testing') -----
testIntersectionWithIncluded
self assert: (aTimespan intersection: anIncludedTimespan) =
(Timespan starting: jan01 duration: (Duration days: 0 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).
self deny: (aTimespan intersection: anIncludedTimespan) = anIncludedTimespan
!
----- Method: TimespanTest>>testIntersectionWithOverlapping (in category 'testing') -----
testIntersectionWithOverlapping
self assert: (aTimespan intersection: anOverlappingTimespan) =
(Timespan starting: jan01 duration: (Duration days: 5 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).
!
----- Method: TimespanTest>>testIntersectionWithSelf (in category 'testing') -----
testIntersectionWithSelf
self assert: (aTimespan intersection: aTimespan) =
(Timespan starting: jan01 duration: (Duration days: 6 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).
self deny: (aTimespan intersection: anIncludedTimespan) = aTimespan
!
----- Method: TimespanTest>>testIntersectionWithSeparate (in category 'testing') -----
testIntersectionWithSeparate
self assert: (aTimespan intersection: aDisjointTimespan) isNil.
self deny: (aTimespan intersection: anOverlappingTimespan) isNil.
self assert: (aTimespan intersection: anIncludedTimespan) =
(Timespan starting: jan01 duration: (Duration days: 0 hours: 23 minutes: 59 seconds: 59 nanoSeconds: 999999999)).
self deny: (aTimespan intersection: anIncludedTimespan) = anIncludedTimespan
!
----- Method: TimespanTest>>testIsLeapYear (in category 'testing') -----
testIsLeapYear
"self assert: anOverlappingTimespan isLeapYear."
"not sure why this fails"
self deny: aTimespan isLeapYear
!
----- Method: TimespanTest>>testJulianDayNumber (in category 'testing') -----
testJulianDayNumber
self assert: aTimespan julianDayNumber = (jan01 julianDayNumber).
!
----- Method: TimespanTest>>testLessThan (in category 'testing') -----
testLessThan
self assert: aTimespan < aDisjointTimespan.
self deny: anIncludedTimespan < aTimespan
!
----- Method: TimespanTest>>testMinusADateAndTime (in category 'testing') -----
testMinusADateAndTime
"It appears that subtracting a date from a Timespan gives you a duration = to the difference between the start of the timespan and the date "
self assert: aTimespan - dec31 = aDay.
self assert: aDisjointTimespan - jan01 = aWeek.
!
----- Method: TimespanTest>>testMinusADuration (in category 'testing') -----
testMinusADuration
"It appears that subtracting a duration from a Timespan gives you a Timespan shifted by the duration"
self assert: aTimespan - aDay = anOverlappingTimespan.
self assert: aDisjointTimespan - aWeek = aTimespan.
!
----- Method: TimespanTest>>testMonth (in category 'testing') -----
testMonth
self assert: aTimespan month = 1.
self assert: aTimespan monthName = 'January'.
self assert: aTimespan monthIndex = 1.!
----- Method: TimespanTest>>testNew (in category 'testing') -----
testNew
self assert: Timespan new = (Timespan starting: '01-01-1901' asDate)!
----- Method: TimespanTest>>testNext (in category 'testing') -----
testNext
self assert: aTimespan next = aDisjointTimespan
!
----- Method: TimespanTest>>testPlus (in category 'testing') -----
testPlus
self assert: aTimespan + aWeek = aDisjointTimespan.
self assert: anOverlappingTimespan + aDay = aTimespan.
!
----- Method: TimespanTest>>testPrevious (in category 'testing') -----
testPrevious
self assert: aTimespan = aDisjointTimespan previous.
self assert: aTimespan next previous = aTimespan
!
----- Method: TimespanTest>>testPrintOn (in category 'testing') -----
testPrintOn
| cs rw |
cs := 'a Timespan(2005-01-01T00:00:00+00:00D7:00:00:00)' readStream.
rw := ReadWriteStream on: ''.
aTimespan printOn: rw.
self assert: rw contents = cs contents!
----- Method: TimespanTest>>testStart (in category 'testing') -----
testStart
self assert: aTimespan start = jan01.
aTimespan start: jan08.
self assert: aTimespan start = jan08.!
----- Method: TimespanTest>>testStartingEnding (in category 'testing') -----
testStartingEnding
self assert: aTimespan = (Timespan starting: jan01 ending: jan08)
!
----- Method: TimespanTest>>testTo (in category 'testing') -----
testTo
self assert: (anIncludedTimespan to: jan08) = aTimespan
!
----- Method: TimespanTest>>testUnion (in category 'Tests') -----
testUnion
| union |
union := timespan union: timespan.
self
assert: (union start = timespan start);
assert: (union duration = timespan duration)
!
----- Method: TimespanTest>>testUnionWithDisjoint (in category 'testing') -----
testUnionWithDisjoint
self assert: (aTimespan union: aDisjointTimespan) =
(Timespan starting: jan01 duration: (14 days)).
!
----- Method: TimespanTest>>testUnionWithIncluded (in category 'testing') -----
testUnionWithIncluded
self
assert: (aTimespan union: anIncludedTimespan) = aTimespan !
----- Method: TimespanTest>>testUnionWithOverlapping (in category 'testing') -----
testUnionWithOverlapping
self
assert: (aTimespan union: anOverlappingTimespan) =
(Timespan starting: dec31 duration: (8 days))!
----- Method: TimespanTest>>testUnionWithSelf (in category 'testing') -----
testUnionWithSelf
self assert: (aTimespan union: aTimespan) = aTimespan
!
----- Method: TimespanTest>>testUnionWithSeparate (in category 'testing') -----
testUnionWithSeparate
self
assert: (anOverlappingTimespan union: aDisjointTimespan) =
(Timespan
starting: anOverlappingTimespan start
ending: (aDisjointTimespan end + DateAndTime clockPrecision))
!
----- Method: TimespanTest>>testWorkDatesDo (in category 'testing') -----
testWorkDatesDo
| count |
count := 0.
aTimespan
workDatesDo: [:each | count := count + 1].
self assert: count = 5!
----- Method: TimespanTest>>testYear (in category 'testing') -----
testYear
self assert: aTimespan year = 2005.
!
----- Method: TimespanTest>>testZeroDuration (in category 'testing') -----
testZeroDuration
| ts |
ts := Timespan starting: Date today duration: Duration zero.
self
assert: ts start = ts end!
ClassTestCase subclass: #TrueTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
----- Method: TrueTest>>testAND (in category 'testing') -----
testAND
self assert: (true & true) = true.
self assert: (true & false) = false.!
----- Method: TrueTest>>testInMemory (in category 'testing') -----
testInMemory
self assert: (false isInMemory = true).!
----- Method: TrueTest>>testNew (in category 'testing') -----
testNew
self should: [True new] raise: Error. !
----- Method: TrueTest>>testNot (in category 'testing') -----
testNot
self assert: (false not = true).!
----- Method: TrueTest>>testPrintOn (in category 'testing') -----
testPrintOn
self assert: (String streamContents: [:stream | true printOn: stream]) = 'true'. !
ClassTestCase subclass: #UndefinedObjectTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
!UndefinedObjectTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class UndefinedObject. 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!
----- Method: UndefinedObjectTest>>testClone (in category 'tests - copying') -----
testClone
self assert: ( nil clone = nil).!
----- Method: UndefinedObjectTest>>testDeepCopy (in category 'tests - copying') -----
testDeepCopy
self assert: (nil deepCopy = nil).!
----- Method: UndefinedObjectTest>>testHaltIfNil (in category 'tests - testing') -----
testHaltIfNil
self should: [ nil haltIfNil] raise: Halt.!
----- Method: UndefinedObjectTest>>testIfNil (in category 'tests - testing') -----
testIfNil
self should: [ nil ifNil: [self halt]] raise: Halt.
!
----- Method: UndefinedObjectTest>>testIfNilIfNotNil (in category 'tests - testing') -----
testIfNilIfNotNil
self should: [ nil ifNil: [self halt] ifNotNil: [self error] ] raise: Halt.
!
----- Method: UndefinedObjectTest>>testIfNotNil (in category 'tests - testing') -----
testIfNotNil
self shouldnt: [ nil ifNotNil: [self halt]] raise: Halt.
!
----- Method: UndefinedObjectTest>>testIfNotNilDo (in category 'tests - testing') -----
testIfNotNilDo
self shouldnt: [ nil ifNotNilDo: [self halt]] raise: Halt.
!
----- Method: UndefinedObjectTest>>testIfNotNilIfNil (in category 'tests - testing') -----
testIfNotNilIfNil
self should: [ nil ifNotNil: [self error] ifNil: [self halt] ] raise: Halt.
!
----- Method: UndefinedObjectTest>>testInitializedInstance (in category 'tests - Class Methods') -----
testInitializedInstance
self assert: ( UndefinedObject initializedInstance class == UndefinedObject).!
----- Method: UndefinedObjectTest>>testIsEmptyOrNil (in category 'tests - testing') -----
testIsEmptyOrNil
self assert: (nil isEmptyOrNil).!
----- Method: UndefinedObjectTest>>testIsLiteral (in category 'tests - testing') -----
testIsLiteral
self assert: (nil isLiteral).!
----- Method: UndefinedObjectTest>>testIsNil (in category 'tests - testing') -----
testIsNil
self assert: (nil isNil).!
----- Method: UndefinedObjectTest>>testNew (in category 'tests - Class Methods') -----
testNew
self should: [ UndefinedObject new] raise: Error.!
----- Method: UndefinedObjectTest>>testNewTileMorphRepresentative (in category 'tests - printing') -----
testNewTileMorphRepresentative
self assert: (nil newTileMorphRepresentative class = UndescribedTile).!
----- Method: UndefinedObjectTest>>testNotNil (in category 'tests - testing') -----
testNotNil
self deny: (nil notNil).!
----- Method: UndefinedObjectTest>>testPrintOn (in category 'tests - printing') -----
testPrintOn
| string |
string := String streamContents: [:stream | nil printOn: stream].
self assert: (string = 'nil').!
----- Method: UndefinedObjectTest>>testShallowCopy (in category 'tests - copying') -----
testShallowCopy
self assert: (nil shallowCopy = nil).!
----- Method: UndefinedObjectTest>>testStoreOn (in category 'tests - printing') -----
testStoreOn
| string |
string := String streamContents: [:stream | nil storeOn: stream].
self assert: ((Compiler evaluate: string) = nil).!
----- Method: UndefinedObjectTest>>testVeryDeepCopyWith (in category 'tests - copying') -----
testVeryDeepCopyWith
self assert: ((nil veryDeepCopyWith: nil) = nil).!
ClassTestCase subclass: #WeakMessageSendTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Objects'!
----- Method: WeakMessageSendTest>>testNoArguments (in category 'tests') -----
testNoArguments
"self run: #testNoArguments"
| m |
m := WeakMessageSend
receiver: true
selector: #yourself.
self assert: (m value).
!
----- Method: WeakMessageSendTest>>testOneArgument (in category 'tests') -----
testOneArgument
"self run: #testOneArgument"
| m |
m := WeakMessageSend
receiver: Array
selector: #with:
argument: 1.
Smalltalk garbageCollectMost.
self assert: (m value = { 1 })
!
----- Method: WeakMessageSendTest>>testOneArgumentWithGC (in category 'tests') -----
testOneArgumentWithGC
| m |
m := WeakMessageSend
receiver: Array
selector: #with:
arguments: { Object new }.
Smalltalk garbageCollectMost.
self assert: (m value isNil)!
----- Method: WeakMessageSendTest>>testReceiverWithGC (in category 'tests') -----
testReceiverWithGC
| m |
m := WeakMessageSend
receiver: Object new
selector: #isNil.
Smalltalk garbageCollectMost.
self assert: (m value isNil).!
----- Method: WeakMessageSendTest>>testTwoArguments (in category 'tests') -----
testTwoArguments
| m |
m := WeakMessageSend
receiver: Array
selector: #with:with:
arguments: { 1 . 2 }.
Smalltalk garbageCollectMost.
self assert: (m value = { 1 . 2 }).
!
ClassTestCase subclass: #WeekTest
instanceVariableNames: 'week restoredStartDay'
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: WeekTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Week!
----- Method: WeekTest>>selectorsToBeIgnored (in category 'Coverage') -----
selectorsToBeIgnored
| deprecated private special |
deprecated := #().
private := #( #printOn: ).
special := #( #next #do: ).
^ super selectorsToBeIgnored, deprecated, private, special.!
----- Method: WeekTest>>setUp (in category 'Running') -----
setUp
"June 1998, 5th week"
super setUp.
restoredStartDay := Week startDay.
Week startDay: #Sunday.
week := Week starting: '4 July 1998' asDate!
----- Method: WeekTest>>tearDown (in category 'Running') -----
tearDown
super tearDown.
Week startDay: restoredStartDay.
week := nil.
!
----- Method: WeekTest>>testEnumerating (in category 'Tests') -----
testEnumerating
| days |
days := OrderedCollection new.
0 to: 6 do: [ :i | days add: ('28 June 1998' asDate addDays: i) ].
week datesDo: [ :d | days remove: d ].
self assert: days isEmpty.
!
----- Method: WeekTest>>testInquiries (in category 'Tests') -----
testInquiries
self
assert: week start asDate = '28 June 1998' asDate;
assert: week end asDate = '4 July 1998' asDate;
assert: week index = 5;
assert: week duration = (7 days).
!
----- Method: WeekTest>>testPreviousNext (in category 'Tests') -----
testPreviousNext
self
assert: week next = (Week starting: '6 July 1998' asDate);
assert: week previous = (Week starting: '22 June 1998' asDate)!
ClassTestCase subclass: #YearTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'KernelTests-Chronology'!
----- Method: YearTest>>classToBeTested (in category 'Coverage') -----
classToBeTested
^ Year!
----- Method: YearTest>>testCurrent (in category 'Tests') -----
testCurrent
| yyyy |
yyyy := DateAndTime now year.
self assert: Year current start = (DateAndTime year: yyyy month: 1 day: 1)!
More information about the Packages
mailing list