Installer: Installer-Core-stephane.ducasse.230.mcz
by squeak-dev-noreplyï¼ lists.squeakfoundation.org 30 Sep '08
by squeak-dev-noreplyï¼ lists.squeakfoundation.org 30 Sep '08
30 Sep '08
Stéphane Ducasse uploaded a new version of Installer-Core to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-stephane.ducasse.230.m…
==================== Summary ====================
Name: Installer-Core-stephane.ducasse.230
Author: stephane.ducasse
Time: 30 September 2008, 6:45:25 pm
UUID: 92281bc6-c1be-4563-b7ea-259c5c4cc875
Ancestors: Installer-Core-kph.229
stef fixing indentation and providing some comments
I read the code of Installer I reformatted the code and publish it.
Now here is a list of questions/suggestions
==============================
Installer class>>classes
^ SmalltalkÂ
not invoked seems bogus
==============================
Entities seems a bad name for html elements mapping.
==============================
history
seems obsolete
Installer class>>mczInstall is misclassified
==============================
Installer class>>sake
^ self sake: (Sake ifNil: [ self classPackages current ])
Does not make sense to me if Sake is not loaded.Â
setSakeToUse: aClass
Sake := aClass
is missing a comment to indicate what is the purpose of Sake?
On the instance side
==============================
user
^ user ifNil: [ '' ]
user: anObject
user := anObject
user is undefined, thanks shout!
==============================
classMCMczReader
^Smalltalk at: #MCMczReader ifAbsent: [ nil ]
classMCReader
^Smalltalk at: #MCReader ifAbsent: [ nil ]
classMczInstaller
^Smalltalk at: #MczInstaller ifAbsent: [ nil ]
why nil and not error as all the others?
==============================
createRBforBug: aBugNoÂ
| aStream  fileList selFile aFileName |
self setBug: aBugNo.
fileList := self maFiles keys asOrderedCollection.
fileList  addLast: 'none'.
ReleaseBuilderFor3dot10 clear.
[selFile := UIManager default chooseFrom: fileList title: 'Choose what files load '.
selFile = fileList size ifFalse:[
aFileName := fileList at: selFile.
self logCR: 'obtaining ', aFileName, '...'.
aStream := self maStreamForFile: aFileName .
ReleaseBuilderFor3dot10 current packagesInfluenced: aStream named: aFileName.
self installCS: aFileName from: aStream].selFile = fileList size]whileFalse.
ReleaseBuilderFor3dot10 current newUpdateFor: aBugNo
ReleaseBuilderFor3dot10 does not exist.
==============================
installMCcs: aFileName from: streamÂ
| reader |
reader := MCCsReader on: stream.
should use self MCCsReader because MCCsReader may not exist
==============================
skipTests is empty
=============== Diff against Installer-Core-kph.229 ===============
Item was changed:
----- Method: Installer class>>unload: (in category 'unload') -----
unload: categoryMatchesString
+ ^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'!
- ^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'!
Item was changed:
----- Method: Installer>>uniUpdate (in category 'universes') -----
uniUpdate
+
(LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ])
ifTrue: [universe requestPackageList.
LastUniUpdate := DateAndTime now]!
Item was changed:
----- Method: Installer class>>sourceFiles (in category 'accessing system') -----
sourceFiles
+ ^ SourceFiles!
- ^ SourceFiles!
Item was changed:
----- Method: Installer class>>squeakmap (in category 'instanciation') -----
squeakmap
+ ^self new sm: true; yourself!
- ^self new sm: true; yourself!
Item was changed:
----- Method: Installer class>>file: (in category 'instanciation') -----
file: fileName
+ ^ self new file: fileName; yourself
- ^ self new file: fileName; yourself
!
Item was changed:
----- Method: Installer class>>classSakePackages (in category 'accessing system') -----
classSakePackages
+ ^Smalltalk at: #SakePackages ifAbsent: [ self error: 'Sake Packages code not present' ]!
- ^Smalltalk at: #SakePackages ifAbsent: [ self error: 'Sake Packages code not present' ]!
Item was changed:
----- Method: Installer class>>url: (in category 'instanciation') -----
url: urlString
+ ^self web url: urlString; yourself!
- ^self web url: urlString; yourself!
Item was changed:
----- Method: Installer>>smUpdate (in category 'squeakmap') -----
smUpdate
"Updates the local map for SqueakMap, upgrading SqueakMap to the latest version if necessary.
When SqueakMap is old and needs to be upgraded, it does four things that mostly make sense in the interactive world SM was built for, but are totally evil here in the world of automatic scripting:
1. It asks the user if she wants to upgrade, in the form of a pop-up (see SMSqueakMap >> #checkVersion:).
2. It terminates its own process.
3. It creates a new UI process.
(see the last line of the SqueakMap upgrade file-in: ''Project spawnNewProcessAndTerminateOld: true'', from
http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/file…
4. It opens a SqueakMap window
We work around these three problems seperately:
1. We use #answer:with: and #withAnswersDo: to automatically answer ''Yes'' when asked if we want to upgrade
2. We don't want this process to be terminated, so we run the update in a forked process and wait for it to finish, using #fork, #ensure:, and a Semaphore
3. We keep track of the UI process before updating, and if it changes, we terminate the new UI process and reinstall the old one using Project >> #resumeProcess:
4. We don't bother with the newly opened window. The other three problems are much worse.
We do all this in a new process, since it is not unlikely that this method is executing in the UI process"
| oldUIProcess newUIProcess doneSema |
self answer: 'You need to upgrade the SqueakMap package' with: true.
oldUIProcess := Project uiProcess.
doneSema := Semaphore new.
+ [[self withAnswersDo: [self classSMSqueakMap default loadUpdates]]
+ ensure: [newUIProcess := Project uiProcess.
+ (oldUIProcess ~~ newUIProcess
+ and: [oldUIProcess notNil]
+ and: [oldUIProcess isTerminated not])
+ ifTrue: [
+ newUIProcess ifNotNil: [newUIProcess terminate].
+ oldUIProcess suspend.
+ Project resumeProcess: oldUIProcess.].
+ doneSema signal]] fork.
-
- [[
- self withAnswersDo: [self classSMSqueakMap default loadUpdates]
- ] ensure: [
- newUIProcess := Project uiProcess.
-
- (
- oldUIProcess ~~ newUIProcess
- and: [oldUIProcess notNil]
- and: [oldUIProcess isTerminated not]
- ) ifTrue: [
- newUIProcess ifNotNil: [newUIProcess terminate].
- oldUIProcess suspend.
- Project resumeProcess: oldUIProcess.
- ].
-
- doneSema signal
- ]] fork.
doneSema wait!
Item was changed:
----- Method: Installer class>>websqueakmap (in category 'instanciation') -----
websqueakmap
+ ^self new wsm: 'http://map.squeak.org'; yourself!
- ^self new wsm: 'http://map.squeak.org'; yourself!
Item was changed:
----- Method: Installer class>>mantis: (in category 'instanciation') -----
mantis: host
+ ^self new ma: host;
- ^self new ma: host;
markers: '"fix begin"..."fix test"..."fix end"';
yourself.
!
Item was changed:
----- Method: Installer>>classMCVersionLoader (in category 'class references') -----
classMCVersionLoader
+ ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]!
- ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]!
Item was changed:
----- Method: Installer class>>cancelSkipLoadingTests (in category 'accessing') -----
cancelSkipLoadingTests
+ "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages"
+
+ SkipLoadingTests := false.
-
- "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages"
- SkipLoadingTests := false.
!
Item was changed:
----- Method: Installer class>>webSearchPath (in category 'accessing') -----
webSearchPath
+ "a search path item, has the following format. prefix*suffix"
+ ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].!
- "a search path item, has the following format. prefix*suffix"
-
- ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].!
Item was changed:
----- Method: Installer class>>fixesApplied (in category 'accessing') -----
fixesApplied
+ ^ Fixes ifNil: [ Fixes := OrderedCollection new ].!
- ^ Fixes ifNil: [ Fixes := OrderedCollection new ].!
Item was changed:
----- Method: Installer class>>classes (in category 'accessing system') -----
classes
+ ^ Smalltalk!
- ^ Smalltalk!
Item was changed:
----- Method: Installer class>>classProjectLauncher (in category 'accessing system') -----
classProjectLauncher
+ ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!
- ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!
Item was changed:
----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
webFindUrlToDownload
+ self class webSearchPath
+ do: [ :pathSpec |
+ | potentialUrl readPathSpec |
+ readPathSpec := pathSpec value readStream.
+ potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
+ [ pageDataStream := self urlGet: potentialUrl ]
+ doWhileTrue: [
+ (pageDataStream notNil and: [ pageDataStream size > 0 ])
+ ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit')
+ ifFalse: [ pageDataStream reset.
+ ^ potentialUrl ] ].
+ (Delay forSeconds: 2) wait.
+ true]].
- self class webSearchPath do: [ :pathSpec |
- | potentialUrl readPathSpec |
- readPathSpec := pathSpec value readStream.
- potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
- [ pageDataStream := self urlGet: potentialUrl ]
-
- doWhileTrue: [
-
- (pageDataStream notNil and: [ pageDataStream size > 0 ])
- ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') ifFalse: [ pageDataStream reset. ^ potentialUrl ] ].
-
- (Delay forSeconds: 2) wait.
- true.
- ].
-
- ].
^nil
!
Item was changed:
----- Method: Installer class>>web (in category 'instanciation') -----
web
+ ^self new !
- ^self new !
Item was changed:
----- Method: Installer class>>do: (in category 'launcher support') -----
do: webPageName
| rs |
-
self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
-
rs := webPageName readStream.
-
[ rs atEnd ] whileFalse: [ self install: (rs upTo: $;) ].
!
Item was changed:
----- Method: Installer class>>validationBlock (in category 'instanciation-abbreviated') -----
validationBlock
-
^ ValidationBlock!
Item was changed:
----- Method: Installer class>>view: (in category 'instanciation') -----
view: webPageNameOrUrl
+ | theReport |
- | theReport |
+ theReport := String streamContents: [ :report |
- theReport := String streamContents: [ :report |
(webPageNameOrUrl beginsWith: 'http://') ifTrue: [
self new urlAction: ('Installer installUrl: ', (webPageNameOrUrl printString),'.')
reportOn: report.
]
ifFalse: [
self new webAction: ('Installer install: ', (webPageNameOrUrl printString),'.')
reportOn: report.
+ ]].
- ].
- ].
-
- Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl.
+ Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl.
+
+ ^theReport contents
- ^theReport contents
!
Item was changed:
----- Method: Installer class>>classPackages (in category 'accessing system') -----
classPackages
+ ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]!
- ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]!
Item was changed:
----- Method: Installer>>maFiles (in category 'mantis') -----
maFiles
+ | file files bugPage id |
+ files := Dictionary new.
+ bugPage := self maPage.
+ [
+ id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&.
+ file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<.
+ ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ].
+ id notEmpty ] whileTrue.
-
- | file files bugPage id |
-
- files := Dictionary new.
-
- bugPage := self maPage.
+ ^files !
- [
- id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&.
- file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<.
-
- ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ].
-
- id notEmpty ] whileTrue.
-
- ^files !
Item was changed:
----- Method: Installer class>>classUGlobalInstaller (in category 'accessing system') -----
classUGlobalInstaller
+ ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]!
- ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]!
Item was changed:
----- Method: Installer class>>classUUniverse (in category 'accessing system') -----
classUUniverse
+ ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]!
- ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]!
Item was changed:
----- Method: Installer class>>installUrl: (in category 'instanciation') -----
installUrl: urlString
+ ^ self web url: urlString; install.
- ^ self web url: urlString; install.
!
Item was changed:
----- Method: Installer class>>skipLoadingTests (in category 'accessing') -----
skipLoadingTests
+ "sets a flag to ignore loading of the testing portion of scripts embedded in pages"
+
+ SkipLoadingTests := true.
-
- "sets a flag to ignore loading of the testing portion of scripts embedded in pages"
- SkipLoadingTests := true.
!
Item was changed:
----- Method: Installer class>>installSilentlyUrl: (in category 'instanciation') -----
installSilentlyUrl: urlString
+ ^ SystemChangeNotifier uniqueInstance doSilently: [ self web url: urlString; install ].
- ^ SystemChangeNotifier uniqueInstance doSilently: [ self web url: urlString; install ].
!
Item was changed:
----- Method: Installer class>>webInstall: (in category 'instanciation') -----
webInstall: webPageName
+ self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
+ ^ self web install: webPageName
- self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
-
- ^ self web install: webPageName
!
Item was changed:
----- Method: Installer class>>installFile: (in category 'instanciation') -----
installFile: fileName
+ ^ (self file: fileName) install.
- ^ (self file: fileName) install.
!
Item was changed:
----- Method: Installer class>>path: (in category 'instanciation') -----
path: aString
"convenience abbreviation"
+
self webSearchPathFrom: aString!
Item was changed:
----- Method: Installer class>>websqueakmap: (in category 'instanciation') -----
websqueakmap: host
+ ^self new wsm: host; yourself!
- ^self new wsm: host; yourself!
Item was changed:
----- Method: Installer>>maPage (in category 'mantis') -----
maPage
+ " self mantis bug: 5251."
- "
- self mantis bug: 5251.
- "
- | page |
+ | page |
+ page := self httpGet: self maUrl.
+ date := ((self maRead: page field: 'Date Updated') value copyUpTo: $ ).
+ date isEmpty ifTrue: [ ^self error: bug, ' not found' ].
+ date := date asDate.
+ ^page reset!
- page := self httpGet: self maUrl.
-
- date := ((self maRead: page field: 'Date Updated') value copyUpTo: $ ).
-
- date isEmpty ifTrue: [ ^self error: bug, ' not found' ].
-
- date := date asDate.
-
- ^page reset!
Item was changed:
----- Method: Installer class>>webSearchPathFrom: (in category 'accessing') -----
webSearchPathFrom: string
| reader wsp path |
-
reader := string readStream.
wsp := self webSearchPath.
-
[ reader atEnd ] whileFalse: [
path := reader upTo: $;.
+ (wsp includes: wsp) ifFalse: [ wsp addFirst: path ]].
- (wsp includes: wsp) ifFalse: [ wsp addFirst: path ]
- ].
!
Item was changed:
----- Method: Installer>>mcThing:from: (in category 'mantis') -----
mcThing: aFileName from: stream
"dont use monticello for .cs or for .st use monticello for .mcs"
| reader |
-
reader := self classMCReader readerClassForFileNamed: aFileName.
-
reader name = 'MCStReader' ifTrue: [ ^ nil ].
-
reader ifNil: [ ^ nil ].
-
(reader respondsTo: #on:fileName:)
+ ifTrue: [ reader := reader on: stream fileName: aFileName.
- ifTrue: [ reader := reader on: stream fileName: aFileName.
^ reader version ]
+ ifFalse: [ reader := reader on: stream.
- ifFalse: [ reader := reader on: stream.
^ reader snapshot ].!
Item was changed:
----- Method: Installer>>unload: (in category 'actions') -----
unload: match
(MCWorkingCopy allManagers select: [ :wc | match match: (wc package name) ])
do: [ :wc |
self logCR: 'Unloading ', wc package asString.
+ wc unload.].
- wc unload.
-
- ].
-
self unloadCleanUp!
Item was changed:
+ ----- Method: Installer class>>noProgressDuring: (in category 'during') -----
- ----- Method: Installer class>>noProgressDuring: (in category 'as yet unclassified') -----
noProgressDuring: block
[ block value: self ] on: ProgressInitiationException do: [ :note | note resume ]
!
Item was changed:
----- Method: Installer>>setBug: (in category 'mantis') -----
setBug: stringOrNumber
-
- | str |
-
- self logCR: stringOrNumber.
-
- stringOrNumber isInteger ifTrue: [ bug := stringOrNumber. desc := ''. ^self ].
-
- bug := stringOrNumber asInteger.
- str := str printString.
- desc := stringOrNumber copyFrom: (str size + 1) to: (stringOrNumber size)
+ | str |
+ self logCR: stringOrNumber.
+ stringOrNumber isInteger ifTrue: [ bug := stringOrNumber. desc := ''. ^self ].
+ bug := stringOrNumber asInteger.
+ str := str printString.
+ desc := stringOrNumber copyFrom: (str size + 1) to: (stringOrNumber size)
+
!
Item was changed:
----- Method: Installer>>mcSortFileBlock (in category 'monticello') -----
mcSortFileBlock
^ [:a :b |
+ [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger]
+ on: Error do: [:ex | false]].!
- [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].!
Item was changed:
----- Method: Installer class>>install: (in category 'instanciation') -----
install: webPageName
+ self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
- self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
+ ^ self web install: webPageName
- ^ self web install: webPageName
!
Item was changed:
----- Method: Installer class>>entities (in category 'accessing') -----
entities
+ ^ Entities ifNil: [ Entities :=
+ "enough entities to be going on with"
+ Dictionary new.
+ Entities at: 'lt' put: '<';
+ at: 'gt' put: '>';
+ at: 'amp' put: '&';
+ at: 'star' put: '*';
+ at: 'quot' put: '"';
+ at: 'nbsp' put: ' ';
+ yourself
- ^ Entities ifNil: [ Entities :=
- "enough entities to be going on with"
- Dictionary new.
- Entities at: 'lt' put: '<';
- at: 'gt' put: '>';
- at: 'amp' put: '&';
- at: 'star' put: '*';
- at: 'quot' put: '"';
- at: 'nbsp' put: ' ';
- yourself
]
!
Item was changed:
----- Method: Installer class>>smalltalkImage (in category 'accessing system') -----
smalltalkImage
+ ^ SmalltalkImage current!
- ^ SmalltalkImage current!
Item was changed:
----- Method: Installer class>>repository: (in category 'instanciation') -----
repository: host
+ ^self monticello http: host !
- ^self monticello http: host !
Item was changed:
+ ----- Method: Installer class>>skipLoadingTestsDuring: (in category 'during') -----
- ----- Method: Installer class>>skipLoadingTestsDuring: (in category 'as yet unclassified') -----
skipLoadingTestsDuring: block
| oldValue |
oldValue := SkipLoadingTests.
SkipLoadingTests := true.
[ block value: self ] ensure:[ SkipLoadingTests := oldValue ].!
1
0
30 Sep '08
A new version of Sake-Packages was added to project Packages:
http://www.squeaksource.com/Packages/Sake-Packages-kph.4.mcz
==================== Summary ====================
Name: Sake-Packages-kph.4
Author: kph
Time: 30 September 2008, 4:23:55 pm
UUID: 2e83cd14-68bc-40a9-85eb-bef2f7384cab
Ancestors: Sake-Packages-dc.3
Latest
=============== Diff against Sake-Packages-dc.3 ===============
Item was added:
+ ----- Method: PackagesDevU>>PolymorphEventEnhancements (in category 'User Interface') -----
+ PolymorphEventEnhancements
+
+ self name: 'Polymorph EventEnhancements'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Basic extension to the event system providing for recurisve short-circuit event handling (avoiding re-entry). Along with the same for "shared" events.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-EventEnhancements-gvc.…'.
+ self provides: #().
+
+ self dependsOn: #().
+
+ !
Item was changed:
----- Method: PackagesDevU>>Nicefonts (in category 'Fonts') -----
Nicefonts
self name: 'Nice fonts'.
+ self version: '0.6'.
- self version: '0.5'.
info category: 'Fonts'.
info description:
'From Juan Vuletich: One of the very few things I don''t like in Squeak is font support. I''m used to nice sub pixel rendered text. I find StrikeFonts and TTFFonts in Squeak equally ugly on LCD monitors. I have been a long time admirer of Henrik Gedenryd''s FreeType work, now continued by Andy Tween. But Andy''s work requires linking the FreeType library, and a new BitBlt plugin with newer modes to work. Something smaller and simpler needs to be done!!
Once installed, execute the following line to install the new fonts. It may take some time so be patient. Also ensure that the ''display depth'' of your image is set to 32 (World menu->appearance->set display depth...).
StrikeFont new installNiceFonts'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: 'http://www.jvuletich.org/NiceFonts.html'.
info squeakMapID: ''.
+ info url: 'http://damien.cassou.free.fr/squeak-dev/fonts/AAStrikeFonts.15.cs'.
- info url: 'http://damien.cassou.free.fr/squeak-dev/fonts/AAStrikeFonts.14.cs'.
self provides: #().
self dependsOn: #().
!
Item was added:
+ ----- Method: PackagesDevU>>PolymorphGeometry (in category 'User Interface') -----
+ PolymorphGeometry
+
+ self name: 'Polymorph Geometry'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Basic models of shapes. Used in Diff Tools.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-Geometry-gvc.1.mcz'.
+ self provides: #().
+
+ self dependsOn: #().
+
+ !
Item was added:
+ ----- Method: PackagesDevU>>Pharopackages (in category 'Distributions') -----
+ Pharopackages
+
+ self name: 'Pharo packages'.
+ self version: '0.6'.
+ info category: 'Distributions'.
+ info description:
+ 'This package generates a Pharo image prepared for end-users from a Pharo core.'.
+ info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
+ info homepage: 'http://code.google.com/p/pharo/'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/ImageForDevelopers/ImageForDevelopers-pharo-dc.…'.
+ self provides: #().
+
+ self dependsOn: #('Installer' 'OB-Enhancements' 'OmniBrowser-Morphic' 'OmniBrowser-Refactory' 'OmniBrowser-Regex' 'OmniBrowser-Standard' 'Shout' 'ShoutWorkspace' 'Universes' 'Universes OmniBrowser' 'eCompletion' 'eCompletion-Traits' 'eCompletionOmniBrowser').
+
+ !
Item was added:
+ ----- Method: PackagesDevU>>PolymorphWidgets (in category 'User Interface') -----
+ PolymorphWidgets
+
+ self name: 'Polymorph Widgets'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Modifies Morphic to provide for selectable theming of controls and provides a framework and extra Morphs for creating consistent user interfaces.
+ Improves both look and feel.
+ Fixes a few problems too (corner grips, window titlebar sizing wrt fonts...).
+
+ Noteable changes since last release:
+
+ UI Enhancements has now been renamed to Polymorph.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-Widgets-gvc.2.mcz'.
+ self provides: #().
+
+ self dependsOn: #().
+
+ !
Item was changed:
----- Method: PackagesDevU>>OmniBrowserRegex (in category 'Development') -----
OmniBrowserRegex
self name: 'OmniBrowser-Regex'.
+ self version: '0.9.1'.
- self version: '0.9'.
info category: 'Development'.
info description:
'Brings refactorings to OmniBrowser'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: ''.
info squeakMapID: ''.
info url: 'http://source.lukas-renggli.ch/omnibrowser/OB-Regex-lr.9.mcz'.
self provides: #().
+ self dependsOn: #('OmniBrowser-Refactory' 'OmniBrowser-Standard' 'Refactoring Core' 'VBRegex').
- self dependsOn: #('OmniBrowser-Refactory' 'OmniBrowser-Standard' 'Refactoring Engine' 'VBRegex').
!
Item was added:
+ ----- Method: PackagesDevU>>PolymorphToolsDiff (in category 'User Interface') -----
+ PolymorphToolsDiff
+
+ self name: 'Polymorph Tools Diff'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Provides side-by-side code comaprison with cross-links indicating changes between lines of text. Highlight "intra-line" changes also.
+ Integrated with "compare with current version" of standard versions browser.
+ Integrated with Monticello replacing changes and merge browsers.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-Tools-Diff-gvc.2.mcz'.
+ self provides: #().
+
+ self dependsOn: #('Polymorph EventEnhancements' 'Polymorph Geometry' 'Polymorph Widgets').
+
+ !
Item was changed:
----- Method: PackagesDevU>>eCompletion (in category 'Code Browsing') -----
eCompletion
self name: 'eCompletion'.
+ self version: '0.90'.
- self version: '0.89'.
info category: 'Code Browsing'.
info description:
'Complete variables, selectors, class names in your browser, workspace, debugger and other code holders.'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: 'http://www.squeaksource.com/eCompletion'.
info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/eCompletion/ECompletion-dc.90.mcz'.
- info url: 'http://www.squeaksource.com/eCompletion/ECompletion-dc.89.mcz'.
self provides: #().
self dependsOn: #('RoelTyper' 'Shout').
!
Item was added:
+ ----- Method: PackagesDevU>>PolymorphToolBuilder (in category 'User Interface') -----
+ PolymorphToolBuilder
+
+ self name: 'Polymorph ToolBuilder'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Integrates Polymorph widgets with Squeak''s development environment via UIManager.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-ToolBuilder-gvc.1.mcz'.
+ self provides: #().
+
+ self dependsOn: #('Polymorph Widgets').
+
+ !
Item was changed:
----- Method: PackagesDevU>>Universes (in category 'Group Development') -----
Universes
self name: 'Universes'.
+ self version: '49'.
- self version: '45'.
info category: 'Group Development'.
info description:
'Package universes is a toolset that supports reliable, automatic installation of packages via a package-browsing tool. The approach of the tools is that users operate within one universe, and each universe only has a large but limited set of packages available. Thus, a universe sets a context that simplifies other aspects of the tools including package naming, dependency management, and package-update policies. '.
info maintainer: '"Lex Spoon" <lex(a)lexspoon.org>'.
info homepage: 'http://www.squeaksource.com/universes/'.
info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/universes/Universes-dc.49.mcz'.
- info url: 'http://www.squeaksource.com/universes/Universes-dc.45.mcz'.
self provides: #().
self dependsOn: #('YAXO').
!
Item was added:
+ ----- Method: PackagesDevU>>PolymorphTaskbarIcons (in category 'User Interface') -----
+ PolymorphTaskbarIcons
+
+ self name: 'Polymorph TaskbarIcons'.
+ self version: '1.0'.
+ info category: 'User Interface'.
+ info description:
+ 'Taskbar/window icons for common windows.'.
+ info maintainer: 'Gary Chambers'.
+ info homepage: 'http://wiki.squeak.org/squeak/6005'.
+ info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/UIEnhancements/Polymorph-TaskbarIcons-gvc.1.mcz'.
+ self provides: #().
+
+ self dependsOn: #('Polymorph Widgets').
+
+ !
Item was changed:
----- Method: PackagesDevU>>OBEnhancements (in category 'Code Browsing') -----
OBEnhancements
self name: 'OB-Enhancements'.
+ self version: '0.219'.
- self version: '0.203'.
info category: 'Code Browsing'.
info description:
'OB-Enhancements extend the OmniBrowser framework with new features such as multiple selection of elements in columns, a package-based view on the image instead of using just class categories, or smart groups to categorize source artifacts.
This package requires the latest version of the OmniBrowser framework.'.
info maintainer: 'David Röthlisberger'.
info homepage: 'http://source.wiresong.ca/ob/'.
info squeakMapID: ''.
+ info url: 'http://source.wiresong.ca/ob/OB-Enhancements-dr.219.mcz'.
- info url: 'http://source.wiresong.ca/ob/OB-Enhancements-dr.203.mcz'.
self provides: #().
self dependsOn: #('OmniBrowser' 'OmniBrowser-Morphic' 'OmniBrowser-Standard').
!
Item was changed:
----- Method: PackagesDevU>>ShoutWorkspace (in category 'Uncategorized') -----
ShoutWorkspace
self name: 'ShoutWorkspace'.
+ self version: '1-tween.4'.
- self version: '1-tween.2'.
info category: 'Uncategorized'.
info description:
'Brings colors to the Workspace. Use Open->Shout Workspace to get the new workspace.'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: 'http://damiencassou.seasidehosting.st/seaside/pier'.
info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/shout/ShoutWorkspace.1-tween.4.mcz'.
- info url: 'http://www.squeaksource.com/shout/ShoutWorkspace.1-tween.2.mcz'.
self provides: #().
self dependsOn: #('Shout').
!
Item was changed:
----- Method: PackagesDevU>>Squeakdevpackagesbeta (in category 'Development') -----
Squeakdevpackagesbeta
self name: 'Squeak dev packages beta'.
+ self version: '0.32'.
- self version: '0.31'.
info category: 'Development'.
info description:
'Abstract package that only depends on other packages. This packages are used to build a squeak distribution for developers.'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: ''.
info squeakMapID: ''.
info url: 'nil'.
self provides: #().
+ self dependsOn: #('Polymorph TaskbarIcons' 'Polymorph ToolBuilder' 'Polymorph Tools Diff' 'Squeak dev packages').
- self dependsOn: #('Diff Tools' 'Squeak dev packages' 'ToolBuilder integration for UI Themes').
!
Item was changed:
----- Method: PackagesDevU>>ExuperyDevelopment (in category 'System') -----
ExuperyDevelopment
self name: 'Exupery Development'.
+ self version: '0.14.1'.
- self version: '0.14'.
info category: 'System'.
info description:
'Provides a development image with the usual tools for Exupery.'.
info maintainer: 'wbk'.
info homepage: ''.
info squeakMapID: ''.
info url: 'http://www.squeaksource.com/Exupery/VMMaker-wbk.80.mcz'.
self provides: #().
+ self dependsOn: #('CommandShell' 'Connectors' 'Exupery' 'FFI' 'GraphViz' 'OSProcessPlugin' 'Speech').
- self dependsOn: #('CommandShell' 'Connectors' 'Exupery' 'FFI' 'GraphViz' 'Speech').
!
Item was added:
+ ----- Method: PackagesDevU>>OSProcessPlugin (in category 'System') -----
+ OSProcessPlugin
+
+ self name: 'OSProcessPlugin'.
+ self version: '4.2.6a'.
+ info category: 'System'.
+ info description:
+ 'OSProcessPlugin (OSPP) provides access to Unix/Linux and Windows operating system functions. OSPP is used by OSProcess for low level system access. Stub classes are provided for other operating systems (porting assistance welcome). OSProcessPlugin contains the complete source code for the Unix and Windows OSProcessPlugin (OSPP). Generate the plugin with VMMaker. No external support code is required.'.
+ info maintainer: 'Dave Lewis'.
+ info homepage: 'http://wiki.squeak.org/squeak/3349'.
+ info squeakMapID: ''.
+ info url: 'http://wiki.squeak.org/squeak/uploads/3349/OSProcessPluginV4-2-6.sar'.
+ self provides: #().
+
+ self dependsOn: #().
+
+ !
Item was changed:
----- Method: PackagesDevU>>Squeakdevimage (in category 'Squeak Distributions') -----
Squeakdevimage
self name: 'Squeak-dev image'.
+ self version: '0.167'.
- self version: '0.164'.
info category: 'Squeak Distributions'.
info description:
'This package creates a squeak image made for developers. If you update a squeak-dev image, you can execute ''DEVImageCreator default install''.'.
info maintainer: 'Damien Cassou <damien.cassou(a)gmail.com>'.
info homepage: 'http://damien.cassou.free.fr/'.
info squeakMapID: ''.
+ info url: 'http://www.squeaksource.com/ImageForDevelopers/ImageForDevelopers-dc.167.mcz'.
- info url: 'http://www.squeaksource.com/ImageForDevelopers/ImageForDevelopers-dc.164.mcz'.
self provides: #().
self dependsOn: #('Squeak dev packages').
!
1
0
30 Sep '08
A new version of Sake-SqueakMap was added to project Packages:
http://www.squeaksource.com/Packages/Sake-SqueakMap-kph.2.mcz
==================== Summary ====================
Name: Sake-SqueakMap-kph.2
Author: kph
Time: 30 September 2008, 4:22:39 pm
UUID: f5fc0f69-fa21-4973-bdf0-41dd007065db
Ancestors: Sake-SqueakMap-kph.1
Latest
=============== Diff against Sake-SqueakMap-kph.1 ===============
Item was added:
+ ----- Method: PackagesSqueakMapData>>SqueakDBX: (in category 'S') -----
+ SqueakDBX: aVersion
+
+ self name: 'SqueakDBX'.
+ self version: aVersion.
+
+ info summary: 'Squeak OpenDBX plugin'.
+ info author: 'Esteban Lorenzano'.
+ info owner: 'Esteban Lorenzano'.
+ info created: '19 August 2008 3:29:44 pm'.
+ info updated: '19 August 2008 3:29:44 pm'.
+ info description:
+
+ 'OpenDBX plugin, provides db connection to free and commercial databases.
+ Currently supports: PostgreSQL, mySQL and Oracle (MSSQL and others should work, but not tested yet).
+ Use FFI to talk to OpenDBX.
+ It works in Unix, OSX and (through MinGW) Windows. '.
+
+ info versions: {
+ {
+ #version -> '(0.7.1)'.
+ #created -> '20 August 2008 3:47:44 pm'.
+ #updated -> '20 August 2008 3:47:44 pm'.
+ #categories -> #('No code changes' 'Development tools' 'Squeak3.10' 'Beta' 'MIT').
+ #id -> '288cceae-932e-46ee-acf1-d15ed92c6c20'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/0e5cb8be-2b4b-40f0-a915-c667fdfd96a5/file…'.
+ }.
+ {
+ #version -> '(0.7)'.
+ #created -> '19 August 2008 3:33:42 pm'.
+ #updated -> '19 August 2008 3:33:42 pm'.
+ #categories -> #('No code changes' 'Development tools' 'Squeak3.10' 'Beta' 'MIT').
+ #id -> '5bbe9ff1-1074-497d-b955-32b4bc266ce0'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/0e5cb8be-2b4b-40f0-a915-c667fdfd96a5/file…'.
+ }.
+ }.
+ !
Item was added:
+ ----- Method: PackagesSqueakMapData>>AOKIProlog: (in category 'A') -----
+ AOKIProlog: aVersion
+
+ self name: 'AOKI Prolog'.
+ self version: aVersion.
+
+ info summary: 'AOKI Prolog set'.
+ info author: 'NISHIHARA Satoshi'.
+ info owner: 'NISHIHARA Satoshi'.
+ info created: '14 September 2008 11:09:51 pm'.
+ info updated: '15 September 2008 10:34:08 am'.
+ info description:
+
+ 'AOKI Prolog for Morphic World.
+
+ GUI works in MVC and Morphic both.
+ MVC, Morphic version runs on 3.8 #6665 later. Morphic version developed Squeak 3.10.2-7179dev08.09.1 image.
+ '.
+
+ info versions: {
+ {
+ #version -> '(1)'.
+ #created -> '14 September 2008 11:51:28 pm'.
+ #updated -> '14 September 2008 11:52:01 pm'.
+ #categories -> #('Not backwards compatible' 'GPL' 'Beta' 'Squeak3.8' 'Squeak3.10').
+ #id -> '57c7d387-83c1-42be-bc93-b38b46c481a3'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/36a7819b-ed87-483b-87d0-dc73d7defac4/file…'.
+ }.
+ }.
+ !
Item was changed:
----- Method: PackagesSqueakMapData>>RepeatTimesMorphicTile: (in category 'R') -----
RepeatTimesMorphicTile: aVersion
self name: 'RepeatTimesMorphicTile'.
self version: aVersion.
info summary: 'A tile for etoys scripting that gives the same functionality as the Smalltalk timesRepeat: selector.'.
info author: 'RJH'.
info owner: 'Robert Hawley'.
info created: '7 July 2008 10:38 pm'.
info updated: '7 July 2008 11:19:37 pm'.
info description:
'A tile for etoys scripting that gives the same functionality as the Smalltalk timesRepeat: selector.
'.
info versions: {
{
#version -> '(1)'.
#created -> '7 July 2008 10:42:43 pm'.
+ #updated -> '19 September 2008 1:04:48 am'.
- #updated -> '7 July 2008 10:42:43 pm'.
#categories -> #('Alpha' 'Squeak3.9' 'SqueakL + MIT' 'Not backwards compatible').
#id -> '0e9cc2ab-c53a-4a93-bf6c-ddfee1752a7d'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/94efac2d-50af-4408-a3d1-a4442eaefe28/file…'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>muO: (in category 'M') -----
muO: aVersion
self name: 'muO'.
self version: aVersion.
info summary: 'Musical Objects for Squeak'.
info author: 'Stéphane Rollandin'.
info owner: 'Stéphane Rollandin'.
info created: '26 May 2005 2:34:58 pm'.
info updated: '25 January 2007 12:08:56 pm'.
info description:
'Development snapshot of muO (Musical Objects for Squeak).
This is a work in progress...
muO is an experimental musical composition system.
It includes a port of GeoMaestro, a Keykit application.
Please follow the installation instructions at
http://www.zogotounga.net/comp/squeak/sqgeo.htm
'.
info versions: {
{
+ #version -> '(1-212)'.
+ #created -> '6 September 2008 7:27:12 pm'.
+ #updated -> '6 September 2008 7:27:12 pm'.
+ #categories -> #('Squeak3.8' 'Not backwards compatible' 'Beta' 'SqueakL + MIT').
+ #id -> '7dcc9c94-148b-4d6a-b69a-2094254ac1cd'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
+ }.
+ {
+ #version -> '(1-208)'.
+ #created -> '30 August 2008 9:39:22 pm'.
+ #updated -> '30 August 2008 9:39:22 pm'.
+ #categories -> #('Squeak3.8' 'Not backwards compatible' 'Beta' 'SqueakL + MIT').
+ #id -> '9dba992b-0b91-4882-b794-e559fe3edd63'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
+ }.
+ {
+ #version -> '(1-206)'.
+ #created -> '21 August 2008 1:47:57 pm'.
+ #updated -> '21 August 2008 1:47:57 pm'.
+ #categories -> #('Squeak3.8' 'SqueakL + MIT' 'Not backwards compatible' 'Beta').
+ #id -> 'c438086d-e55e-4904-abc4-25d75bf31576'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
+ }.
+ {
#version -> '(1-202)'.
#created -> '7 July 2008 9:44:37 am'.
#updated -> '7 July 2008 9:44:37 am'.
#categories -> #('Beta' 'Squeak3.8' 'SqueakL + MIT' 'Not backwards compatible').
#id -> 'ae27eb62-c11e-42ac-b041-ae83a8e6f5dd'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-200)'.
#created -> '1 May 2008 9:11:16 pm'.
#updated -> '1 May 2008 9:11:16 pm'.
#categories -> #('Beta' 'SqueakL + MIT' 'Squeak3.8' 'Not backwards compatible').
#id -> '8d23a716-2e31-45e6-8345-3e27b117dac6'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-197)'.
#created -> '3 April 2008 9:34:57 pm'.
#updated -> '3 April 2008 9:34:57 pm'.
#categories -> #('Beta' 'SqueakL + MIT' 'Squeak3.8' 'Not backwards compatible').
#id -> 'd458fcb6-f89b-4f3f-bc06-010f90b6acd9'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-195)'.
#created -> '1 April 2008 3:42:07 pm'.
#updated -> '1 April 2008 3:43:11 pm'.
#categories -> #('Beta' 'SqueakL + MIT' 'Squeak3.8' 'Not backwards compatible').
#id -> '78034795-cae4-43ba-b459-444758ec45e3'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-193)'.
#created -> '25 March 2008 12:59:17 pm'.
#updated -> '25 March 2008 12:59:17 pm'.
#categories -> #('Beta' 'SqueakL + MIT' 'Squeak3.8' 'Not backwards compatible').
#id -> 'b615f952-1fd5-410a-a2fc-ed59802ce6a9'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-191)'.
#created -> '12 March 2008 9:37:09 am'.
#updated -> '12 March 2008 9:37:09 am'.
#categories -> #('Beta' 'Not backwards compatible' 'SqueakL + MIT' 'Squeak3.8').
#id -> '1de07f2c-49ca-4988-8bad-cb48fe37973b'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-190)'.
#created -> '25 May 2007 12:19:06 pm'.
#updated -> '25 May 2007 12:19:06 pm'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Beta' 'Squeak3.8').
#id -> '40380ffd-916d-4fc9-ac70-bf133c01cfe7'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-189)'.
#created -> '15 May 2007 8:45:39 pm'.
#updated -> '15 May 2007 8:45:39 pm'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Beta' 'Squeak3.8').
#id -> '4991ee7a-2482-4ade-b301-3b51ea5a9699'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-187)'.
#created -> '16 March 2007 10:03:57 am'.
#updated -> '16 March 2007 10:03:57 am'.
#categories -> #('Beta' 'Squeak3.8' 'Not backwards compatible' 'SqueakL + MIT').
#id -> '44d5b19c-860d-4a2b-ad2a-20b965b09037'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-185)'.
#created -> '9 March 2007 10:50:31 pm'.
#updated -> '9 March 2007 10:50:31 pm'.
#categories -> #('Beta' 'Squeak3.8' 'Not backwards compatible' 'SqueakL + MIT').
#id -> '46417446-0a6a-49c9-b57e-dd1aea2373af'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-184)'.
#created -> '10 February 2007 2:57:48 pm'.
#updated -> '10 February 2007 2:57:48 pm'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Beta' 'Squeak3.8').
#id -> '2132b5da-6ece-42d3-bb79-c71ceaac2c07'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-182)'.
#created -> '30 January 2007 8:06:17 pm'.
#updated -> '30 January 2007 8:07:17 pm'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Beta' 'Squeak3.8').
#id -> '4cc79f46-9bf0-42de-8e45-3c4456af148a'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '(1-180)'.
#created -> '25 January 2007 11:22:43 am'.
#updated -> '25 January 2007 11:22:43 am'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Beta' 'Squeak3.8').
#id -> '6307f72b-536b-4333-880c-5e701acc5390'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
}.
!
Item was added:
+ ----- Method: PackagesSqueakMapData>>KoreanLanguageEnvironment: (in category 'K') -----
+ KoreanLanguageEnvironment: aVersion
+
+ self name: 'KoreanLanguageEnvironment'.
+ self version: aVersion.
+
+ info summary: 'organize the Korean Language Environment in Squeak'.
+ info author: 'YunJae, Jang <janggoons(a)gmail.com>'.
+ info owner: 'Yun Jae, Jang'.
+ info created: '22 September 2008 11:55:42 pm'.
+ info updated: '22 September 2008 11:55:42 pm'.
+ info description:
+
+ ''.
+
+ info versions: {
+ {
+ #version -> 'KoreanLanguageEnvironment-beta-1'.
+ #created -> '23 September 2008 12:41:56 am'.
+ #updated -> '23 September 2008 12:41:56 am'.
+ #categories -> #('Code changes, but only internal' 'Alpha' 'SqueakL' 'Squeak3.10').
+ #id -> 'd0277deb-7eeb-4d0c-8532-2f2f46a55a1e'.
+ #publisher -> 'Yun Jae, Jang'.
+ #url ->'http://map.squeak.org/accountbyid/e52f1f99-f9d2-4529-9664-126951af76df/file…'.
+ }.
+ {
+ #version -> 'KoreanLanguageEnvironment-beta-1'.
+ #created -> '23 September 2008 12:35:48 am'.
+ #updated -> '23 September 2008 12:39:47 am'.
+ #categories -> #('Code changes, but only internal' 'Alpha' 'SqueakL' 'Squeak3.10').
+ #id -> 'c916ed15-ce03-43e9-92d1-0cb5cb523d14'.
+ #publisher -> 'Yun Jae, Jang'.
+ #url ->'http://map.squeak.org/accountbyid/e52f1f99-f9d2-4529-9664-126951af76df/file…'.
+ }.
+ }.
+ !
Item was changed:
----- Method: PackagesSqueakMapData>>PierUnixSecurity: (in category 'P') -----
PierUnixSecurity: aVersion
self name: 'Pier Unix Security'.
self version: aVersion.
info summary: 'Simple Unix like security with ownership, groups, and others.'.
info author: 'Lukas Renggli <renggli(a)iam.unibe.ch>'.
info owner: 'Lukas Renggli'.
info created: '7 January 2006 1:54:39 pm'.
info updated: '10 January 2007 10:06:14 am'.
info description:
''.
info versions: {
{
+ #version -> '(1.0.17)'.
+ #created -> '29 September 2008 5:03:43 pm'.
+ #updated -> '29 September 2008 5:03:43 pm'.
+ #categories -> #().
+ #id -> 'f31f2f3f-e5db-4da6-87c3-8946c18965fc'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
+ }.
+ {
#version -> '(1.0.16)'.
+ #created -> '24 August 2008 11:13:24 am'.
+ #updated -> '24 August 2008 11:13:24 am'.
- #created -> '14 May 2008 5:23:31 am'.
- #updated -> '14 May 2008 5:23:31 am'.
#categories -> #().
+ #id -> '43d2fa70-a944-4f5a-b64e-a6786fff3da1'.
- #id -> '2e0d8f7f-e135-4717-800b-ea9d82fc887b'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.14-alpha)'.
#created -> '13 September 2007 8:09:04 pm'.
#updated -> '13 September 2007 8:09:04 pm'.
#categories -> #().
#id -> '026b2c6c-57df-45eb-bd73-17718157a9af'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.8-alpha)'.
#created -> '12 September 2007 4:27:48 pm'.
#updated -> '12 September 2007 4:27:48 pm'.
#categories -> #().
#id -> 'cdd1add1-1bbd-4db2-9a4b-fc950cf75f3c'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.7-alpha)'.
#created -> '28 May 2007 3:16:31 pm'.
#updated -> '28 May 2007 3:16:31 pm'.
#categories -> #().
#id -> '5c45da4c-bdb8-4feb-adb4-1c4c46d00041'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.6-alpha)'.
#created -> '24 February 2007 8:11:05 pm'.
#updated -> '24 February 2007 8:11:05 pm'.
#categories -> #().
#id -> '0e10e5a4-c39c-4461-966f-84cad0d39726'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.5-alpha)'.
#created -> '11 January 2007 3:03:52 pm'.
#updated -> '11 January 2007 3:03:52 pm'.
#categories -> #().
#id -> '0d8f6bdc-d92a-4b00-b9fa-a3def69bd07b'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.4-alpha)'.
#created -> '30 October 2006 9:06:39 pm'.
#updated -> '30 October 2006 9:06:39 pm'.
#categories -> #().
#id -> '77f895d4-43ee-437d-8392-681aa8692ae2'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.3-alpha)'.
#created -> '29 June 2006 10:52:23 pm'.
#updated -> '29 June 2006 10:52:23 pm'.
#categories -> #().
#id -> 'ff651a1d-6d52-4368-bc3b-d8e8dc6af8ae'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.2-alpha)'.
#created -> '21 March 2006 7:13:33 pm'.
#updated -> '21 March 2006 7:13:33 pm'.
#categories -> #().
#id -> 'd1bb81c0-d61d-44fe-931e-339f100daafe'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.0-alpha)'.
#created -> '7 January 2006 2:11:27 pm'.
#updated -> '7 January 2006 2:11:27 pm'.
#categories -> #().
#id -> '55dbeabd-ad03-423a-acca-1e270da40688'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
}.
!
Item was added:
+ ----- Method: PackagesSqueakMapData>>Voronoi2dDiagram: (in category 'V') -----
+ Voronoi2dDiagram: aVersion
+
+ self name: 'Voronoi-2d-Diagram'.
+ self version: aVersion.
+
+ info summary: '2-dimensional Voronoi and Delaunay diagrams'.
+ info author: 'NISHIHARA Satoshi'.
+ info owner: 'NISHIHARA Satoshi'.
+ info created: '14 September 2008 11:29:07 pm'.
+ info updated: '15 September 2008 10:34:37 am'.
+ info description:
+
+ 'GUI works in MVC and Morphic both.
+ MVC, Morphic version runs on 3.8 #6665 later. Morphic version developed Squeak 3.10.2-7179dev08.09.1 image.
+ '.
+
+ info versions: {
+ {
+ #version -> '(1)'.
+ #created -> '14 September 2008 11:32:30 pm'.
+ #updated -> '14 September 2008 11:33:30 pm'.
+ #categories -> #('Squeak3.10' 'GPL' 'Not backwards compatible' 'Beta' 'Squeak3.8').
+ #id -> 'c86ac19c-9b89-41d7-8984-53d42596e579'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/36a7819b-ed87-483b-87d0-dc73d7defac4/file…'.
+ }.
+ }.
+ !
Item was changed:
----- Method: PackagesSqueakMapData>>Pier: (in category 'P') -----
Pier: aVersion
self name: 'Pier'.
self version: aVersion.
info summary: 'Meta-described collaborative application framework'.
info author: 'Lukas Renggli <renggli(a)iam.unibe.ch>'.
info owner: 'Lukas Renggli'.
info created: '17 November 2005 3:39:49 pm'.
info updated: '10 January 2007 10:05:43 am'.
info description:
''.
info versions: {
{
+ #version -> '(1.0.17)'.
+ #created -> '29 September 2008 5:03:37 pm'.
+ #updated -> '29 September 2008 5:03:37 pm'.
+ #categories -> #().
+ #id -> '2e90313f-de08-42c7-a519-ffa8025fe9ec'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
+ }.
+ {
#version -> '(1.0.16)'.
+ #created -> '24 August 2008 11:13:20 am'.
+ #updated -> '24 August 2008 11:13:20 am'.
- #created -> '14 May 2008 5:31:21 am'.
- #updated -> '14 May 2008 5:31:21 am'.
#categories -> #().
+ #id -> 'a6884434-68d8-4331-b046-f25b1368fdf6'.
- #id -> '4979c423-29c7-45c0-a150-c16bc9039fd4'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.14-alpha)'.
#created -> '17 September 2007 8:27:01 pm'.
#updated -> '17 September 2007 8:27:01 pm'.
#categories -> #().
#id -> '3847f363-9017-4740-87d6-9617fb673889'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.11-alpha)'.
#created -> '12 September 2007 4:27:39 pm'.
#updated -> '12 September 2007 4:27:39 pm'.
#categories -> #().
#id -> '563df0d7-a4a7-4f44-a1be-51c1493b1bca'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.10-alpha)'.
#created -> '28 May 2007 3:16:13 pm'.
#updated -> '28 May 2007 3:16:13 pm'.
#categories -> #().
#id -> '11a0c519-dfac-4e47-a611-e2c5bdc54e3a'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.9-alpha)'.
#created -> '24 February 2007 8:10:58 pm'.
#updated -> '24 February 2007 8:10:58 pm'.
#categories -> #().
#id -> '001b1f4e-68a9-42aa-968d-f2e31f401d43'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.8-alpha)'.
#created -> '11 January 2007 3:03:46 pm'.
#updated -> '11 January 2007 3:03:46 pm'.
#categories -> #().
#id -> 'b431e1f0-c58d-48cf-b3e0-5a9ebe2647a9'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.7-alpha)'.
#created -> '30 October 2006 9:19:59 pm'.
#updated -> '30 October 2006 9:19:59 pm'.
#categories -> #().
#id -> 'a001c14a-1ae3-45f3-a697-af587514fda3'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.6-alpha)'.
#created -> '30 October 2006 9:06:33 pm'.
#updated -> '30 October 2006 9:06:33 pm'.
#categories -> #().
#id -> 'dba115d6-8149-40e0-99b2-af9a124b0a67'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.5-alpha)'.
#created -> '29 June 2006 10:52:02 pm'.
#updated -> '29 June 2006 10:52:02 pm'.
#categories -> #().
#id -> '183354e3-b902-48bd-9bb6-7e4e4a82b999'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.4-alpha)'.
#created -> '21 March 2006 7:13:13 pm'.
#updated -> '21 March 2006 7:13:13 pm'.
#categories -> #().
#id -> 'ad937a7e-9f11-4acb-b073-d977024abb8c'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.3-alpha)'.
#created -> '17 March 2006 4:51:11 pm'.
#updated -> '17 March 2006 4:51:11 pm'.
#categories -> #().
#id -> 'a7e01fd4-3aaa-40ff-b0b8-efd2f5b6883a'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.2-alpha)'.
#created -> '7 January 2006 1:39:33 pm'.
#updated -> '7 January 2006 1:39:33 pm'.
#categories -> #().
#id -> '554d6ff1-9261-4535-bd30-8a6ff93dae91'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.1-alpha)'.
#created -> '21 November 2005 9:22:57 pm'.
#updated -> '21 November 2005 9:22:57 pm'.
#categories -> #().
#id -> '3ba632e9-d516-4aa2-adfa-17f78f6684de'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.0-alpha)'.
#created -> '17 November 2005 7:05:32 pm'.
#updated -> '17 November 2005 7:05:32 pm'.
#categories -> #().
#id -> '4892f6b0-e4c4-4aec-bf1b-7cc178516b64'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>KomHttpServer: (in category 'K') -----
KomHttpServer: aVersion
self name: 'KomHttpServer'.
self version: aVersion.
info summary: 'The Comanche Http Server'.
info author: 'Mainly Bolot Kerimbaev and Stephen Pair'.
info owner: 'Göran Krampe'.
info created: '16 May 2003 5:03:11 am'.
info updated: '23 October 2007 1:56:57 pm'.
info description:
'Prerequisite packages:
*KomServices* (which in turn needs *DynamicBindings* and, if you are using a pre-3.7-image, *NamedProcess*)
KomHttpServer is the Comanche web server package. To get a simple web server running, install this package and evaluate the code below. A simple file serving web server will be started and will serve the files in your default directory.
| ma |
ma := ModuleAssembly core.
ma serverRoot: FileDirectory default fullName.
ma documentRoot: FileDirectory default fullName.
ma directoryIndex: ''index.html index.htm''.
ma serveFiles.
(HttpService startOn: 8080 named: ''httpd'') plug: ma rootModule
After starting the server, point your web browser to http://localhost:8080/
If you have loaded Seaside, you can start a web server that serves Seaside based applications using the following configuration:
| ma seaside |
seaside := WAKom default.
ma := ModuleAssembly core.
ma serverRoot: FileDirectory default fullName.
ma alias: ''/seaside'' to: [ma addPlug: [:request | seaside process: request]].
ma documentRoot: FileDirectory default fullName.
ma directoryIndex: ''index.html index.htm''.
ma serveFiles.
(HttpService startOn: 8080 named: ''httpd'') plug: ma rootModule
See the class comments of the various subclasses of ComancheModule for documentation and usage examples.
===== Release History =====
For newer releases see note on respective SqueakMap release. Below included for historical record.
Version 6.2:
- Added support for Squeak 3.6
- Now uses SocketStream from the network rewrite
Version 6.1:
- (build #41) Fixes various issues for running on Mac OSX
- Packaged using KomPackaging (Squeak version only)
- Separated the services framework into a separate package called KomServices
- Added a module framework
- The following modules have been added (see the individual classes for details):
- ModCore - this is the core module and designed to be the root of a module assembly, it extracts basic information from the request and makes it available to sub-modules, it also handles http TRACE and OPTIONS methods
- ModMulti - this is a module designed only to wrap submodules into a single entity
- ModAlias - for mapping url prefixes to sub modules
- ModAuth - for authentication
- KomAuthDb - a very basic user and password database
- ModAutoIndex - for generating directory listings
- ModDir - for directory processing (including redirects to fix the trailing slash problem)
- ModDoc - for file location processing in a file server
- ModVhost - for name based virtual hosting
- ModVhostDoc - for document serving based on virtual host name
- ModVhostAlias - for module routing based on the virtual host name
- ModFile - for serving files
- ModLog - for logging http requests (not yet usable)
- KomLogger - writes out a log in CLF format
- KomTracer - writes out a detailed trace of http request/response pairs
- ModNotFound - if reached will generate a not found response
- ModSession - for client session handling
- KomSession - the session class used by ModSession (by default)
- Added ModuleAssembly to help in creating module assemblies
- Renamed classes:
- ComancheHttpService -> HttpService
- Removed classes
- BoundedStream
- HttpBadRequest
- HttpParser
- NetworkProtocolAdaptor
- NetworkRequest
Version 6.0.1:
- Adds pluggability to ComancheHttpService (see class comments).
Version 6.0:
- Initial ComancheNG release
===== Future Enhancement Plans =====
- add WebDAV server capability (in a separate package)
- synchronize with the network rewrite project - DONE
- separate some of the http protocol support into a separate package and provide an Http/WebDAV client implementation (separate package)
- rework the handling of chunked responses (using the SharedStreams package)
- rework the handling of document uploads (via multipart/form-data) using the SharedStreams package
- support chunked transfer encoding for incoming requests
- Reify cookies and make them easier to work with
- Slim down HttpRequest and HttpResponse such that they are only responsible for constructing requests and responses (currently, these classes are heavily overloaded)
'.
info versions: {
{
+ #version -> '7.1a'.
+ #created -> '30 August 2008 3:34:15 pm'.
+ #updated -> '2 September 2008 7:38:53 pm'.
+ #categories -> #('Squeak3.8' 'Squeak3.9' 'SqueakL + MIT' 'Code changes, may break compatibility' 'Monticello' 'Stable' 'Squeak3.7' 'Alpha').
+ #id -> 'b46f85d2-1c81-4a3d-af48-7b4a88271ea9'.
+ #publisher -> 'Giovanni Corriga'.
+ #url ->'http://www.squeaksource.com/KomHttpServer/KomHttpServer-gc.42.mcz'.
+ }.
+ {
#version -> '7.0.5'.
#created -> '26 October 2007 7:48:42 am'.
#updated -> '26 October 2007 11:13:17 am'.
#categories -> #('Stable' 'Squeak3.9' 'Squeak3.6' 'Squeak3.9-alpha' 'Monticello' 'Squeak3.8' 'Squeak3.7' 'Squeak3.10-alpha' 'SqueakL + MIT' 'Code changes, but only internal').
#id -> 'c488c2d6-e436-4ed7-bd8b-a535ca532b8e'.
#publisher -> 'Giovanni Corriga'.
#url ->'http://www.squeaksource.com/KomHttpServer/KomHttpServer-gc.30.mcz'.
}.
{
#version -> '7.0.4'.
#created -> '4 September 2006 9:11:35 am'.
#updated -> '4 September 2006 9:11:35 am'.
#categories -> #('Squeak3.6' 'Squeak3.2.1' 'SqueakL + MIT' 'Stable' 'Squeak3.7' 'Code changes, but only internal' 'Squeak3.5' 'Squeak3.4' 'Squeak3.8' 'Squeak3.2' 'No code changes').
#id -> '012a19f9-acdd-4f50-9900-9dd05558a8a3'.
#publisher -> 'Göran Krampe'.
#url ->'http://squeak.krampe.se/KomHttpServer-gk.14.mcz'.
}.
{
#version -> '7.0.3'.
#created -> '6 December 2005 9:59:58 pm'.
#updated -> '6 December 2005 9:59:58 pm'.
#categories -> #('Squeak3.2' 'Squeak3.8' 'Squeak3.7' 'Squeak3.5' 'SqueakL + MIT' 'Code changes, but only internal' 'Stable' 'No code changes' 'Squeak3.2.1' 'Squeak3.6' 'Squeak3.4').
#id -> '3939a656-2011-48de-9fac-a90c0a8bef39'.
#publisher -> 'Göran Krampe'.
#url ->'http://squeak.krampe.se/KomHttpServer-gk.10.mcz'.
}.
{
#version -> '7.0.2'.
#created -> '30 November 2004 12:28:39 pm'.
#updated -> '30 November 2004 12:28:39 pm'.
#categories -> #('Squeak3.4' 'Squeak3.6' 'No code changes' 'SqueakL + MIT' 'Code changes, but only internal' 'Squeak3.5' 'Squeak3.2.1' 'Squeak3.2' 'Squeak3.7' 'Stable').
#id -> 'f22c82bf-458b-4006-ad62-c12b6754f51a'.
#publisher -> 'Göran Krampe'.
#url ->'http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/file…'.
}.
{
#version -> '7.0.1'.
#created -> '10 November 2004 1:49:14 pm'.
#updated -> '15 November 2004 2:30:35 pm'.
#categories -> #('Squeak3.2.1' 'Squeak3.5' 'No code changes' 'Stable' 'SqueakL + MIT' 'Squeak3.7' 'Squeak3.6' 'Code changes, but only internal' 'Squeak3.2' 'Squeak3.4').
#id -> 'db742634-8bf1-49c1-860a-e3529ec035c8'.
#publisher -> 'Göran Krampe'.
#url ->'http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/file…'.
}.
{
#version -> '6.2'.
#created -> '16 May 2003 5:03:11 am'.
#updated -> '4 August 2004 4:10:19 pm'.
#categories -> #('SqueakL + MIT' 'Squeak3.5' 'Squeak3.4' 'Squeak3.7' 'Squeak3.2.1' 'Squeak3.2' 'Squeak3.6' 'No code changes' 'Stable').
#id -> '17468f59-b1b4-49ed-9180-1506f7982331'.
#publisher -> 'Göran Krampe'.
#url ->'http://squeaklab.org/comanche/httpserver/downloads/KomHttpServer-6.2.sar'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>SandstoneDb: (in category 'S') -----
SandstoneDb: aVersion
self name: 'SandstoneDb'.
self version: aVersion.
info summary: 'A simple ActiveRecord style object database intended for use with Seaside.'.
info author: 'Ramon Leon'.
info owner: 'Ramon Leon'.
info created: '27 July 2008 4:15:01 pm'.
info updated: '27 July 2008 4:41:11 pm'.
info description:
'SandstoneDb is a lightweight Prevayler style embedded object database with an ActiveRecord API that doesn''t require a command pattern and works for small apps that a single Squeak image can handle. The idea is to make a Squeak image durable and crash proof and suitable for use in small office applications.
Data is kept in ram for speed and on disk for safety. All data is reloaded from disk on image startup.
Since we''re dealing with live objects in memory, concurrency is handled via optional record level critical sections rather than optimistic locking and commit failures. It''s up to the developer to use critical sections at the appropriate points by using the critical method on the record.
Saves are atomic for an ActiveRecord and all its non ActiveRecord children, for example, an order and its items. There is no atomic save across multiple ActiveRecords. A record is a cluster of objects that are stored in a single file together.
Assuming you have the latest SUnit (SUnitGUI-improved from Universe), all tests should pass.
For more information and API see http://onsmalltalk.com/programming/smalltalk/sandstonedb-simple-activerecor…'.
info versions: {
{
+ #version -> '108'.
+ #created -> '24 September 2008 5:33:56 pm'.
+ #updated -> '24 September 2008 5:33:56 pm'.
+ #categories -> #('Squeak3.9' 'Only extensions, no changes' 'MIT' 'Class libraries' 'Official package in Full' 'Stable').
+ #id -> '0c0fe9fb-913c-4861-950c-26a1358f263f'.
+ #publisher -> 'Ramon Leon'.
+ #url ->'http://www.squeaksource.com/SandstoneDb/SandstoneDb-rjl.108.mcz'.
+ }.
+ {
#version -> '72'.
#created -> '27 July 2008 4:29:51 pm'.
#updated -> '28 July 2008 8:53:03 pm'.
#categories -> #('Stable' 'Only extensions, no changes' 'Squeak3.9' 'MIT' 'Class libraries' 'Official package in Full').
#id -> 'f1be061a-f39f-4288-9ced-25d1c6547e9b'.
#publisher -> 'Ramon Leon'.
#url ->'http://www.squeaksource.com/SandstoneDb/SandstoneDb-rjl.72.mcz'.
}.
}.
!
Item was added:
+ ----- Method: PackagesSqueakMapData>>EqualityComparison: (in category 'E') -----
+ EqualityComparison: aVersion
+
+ self name: 'Equality Comparison'.
+
+ info summary: 'Quick , easy , and bug free way to create #hash , #= method to any class you want!!'.
+ info author: 'Howard J. Oh'.
+ info owner: 'Howard J. Oh'.
+ info created: '29 September 2008 10:34:26 am'.
+ info updated: '29 September 2008 10:34:26 am'.
+ info description:
+
+ 'Everyday of your life, you might create dozens of class into your image. While doing it, it is often the case that you make mistakes writing #hash, #= to your class. #hash and #= are very close to each other, but a slightest mistake can cause hard to find bug. Any two object of equal must yield same hash value.
+
+ Make a method that creates EqualityComparison object and supply the ''getter accessors'' to it and implement both #hash and #= by using the object. It is simple, time saving, and foolproof way to go.'.
+
+ info versions: {
+ }.
+ !
Item was changed:
----- Method: PackagesSqueakMapData>>Seaside: (in category 'S') -----
Seaside: aVersion
self name: 'Seaside'.
self version: aVersion.
info summary: 'Develop clean, complex, and reusable web components.'.
info author: 'Avi Bryant'.
info owner: 'Avi Bryant'.
info created: '16 September 2002 8:12:08 pm'.
info updated: '13 March 2007 10:23:47 pm'.
info description:
'A framework for building sophisticated web applications in Squeak. Develop for the web using reusable, embeddable components and unique call/return semantics for moving between pages.
Seaside requires a web server; the most commonly used is KomHttpServer.'.
info versions: {
+ {
+ #version -> '(2.8.3)'.
+ #created -> '24 August 2008 11:12:59 am'.
+ #updated -> '24 August 2008 11:12:59 am'.
+ #categories -> #().
+ #id -> '468a8b0e-377f-49bf-b36a-c3caaa034d9f'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
+ }.
{
#version -> '2.8.2'.
#created -> '8 June 2008 5:45:23 pm'.
#updated -> '8 June 2008 5:48:24 pm'.
#categories -> #('Code changes, but only bug fixes' 'Squeak3.9' 'MIT' 'Stable').
#id -> 'a0da204a-ca1a-4c52-9275-b8c6ea8d83d2'.
#publisher -> 'Lukas Renggli'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '2.8.1'.
#created -> '14 May 2008 5:24:06 am'.
#updated -> '8 June 2008 5:48:55 pm'.
#categories -> #('Code changes, but only bug fixes' 'Squeak3.9' 'MIT' 'Stable').
#id -> '10186e74-c78f-41f9-9e2e-9b211f58369f'.
#publisher -> 'Lukas Renggli'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '2.8'.
#created -> '28 October 2007 2:47:33 pm'.
#updated -> '28 October 2007 3:01:15 pm'.
#categories -> #('Squeak3.9' 'Stable' 'Code changes, may break compatibility' 'MIT').
#id -> '11b1f304-2630-48c8-9c26-634c9befb8db'.
#publisher -> 'Lukas Renggli'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(2.8-beta)'.
#created -> '13 September 2007 7:40:33 pm'.
#updated -> '13 September 2007 7:40:33 pm'.
#categories -> #().
#id -> '799f24e1-77b3-4b5d-bb1f-6ab01c4e2b74'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(2.8a)'.
#created -> '18 March 2007 7:17:13 pm'.
#updated -> '18 March 2007 7:17:13 pm'.
#categories -> #().
#id -> '6962ea21-9fe2-4ede-bd9b-56e2295c78da'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '2.7'.
#created -> '15 March 2007 8:02:06 am'.
#updated -> '15 March 2007 8:04 am'.
#categories -> #('Alpha' 'Code changes, but only internal' 'Stable' 'MIT' 'Monticello' 'Squeak3.6' 'Code changes, may break compatibility' 'Squeak3.9' 'Squeak3.8' 'Squeak3.7' 'Other license').
#id -> 'd3548631-b8c1-4d78-b598-ae4103f4437f'.
#publisher -> 'Lukas Renggli'.
#url ->'http://www.squeaksource.com/Seaside/SeasideInstaller-lr.12.mcz'.
}.
{
#version -> '(2.7a)'.
#created -> '15 March 2007 8:00:06 am'.
#updated -> '15 March 2007 8:10:01 am'.
#categories -> #('Alpha' 'Code changes, but only internal' 'Stable' 'MIT' 'Monticello' 'Squeak3.6' 'Code changes, may break compatibility' 'Squeak3.9' 'Squeak3.8' 'Squeak3.7' 'Other license').
#id -> '4b9f632a-1c8f-4aa1-b013-fa00fac94444'.
#publisher -> 'nil'.
#url ->'http://www.squeaksource.com/Seaside/SeasideInstaller-lr.11.mcz'.
}.
{
#version -> '(2.6a)'.
#created -> '28 November 2005 10:51:21 am'.
#updated -> '8 January 2006 11:13:36 pm'.
#categories -> #('Beta' 'Squeak3.7' 'Monticello' 'Stable' 'Code changes, may break compatibility' 'Other license' 'Squeak3.6' 'Squeak3.8' 'Code changes, but only internal' 'MIT' 'Alpha').
#id -> 'fc7ee2dd-1a9c-4303-a691-b9035e3c27b1'.
#publisher -> 'nil'.
#url ->'http://www.squeaksource.com/Seaside/Seaside2.6a3-avi.4.mcz'.
}.
{
#version -> '2.5'.
#created -> '29 May 2005 4:08:14 pm'.
#updated -> '29 May 2005 4:08:14 pm'.
#categories -> #('Beta' 'Code changes, but only internal' 'Squeak3.7' 'Other license' 'Monticello' 'Squeak3.8' 'Alpha' 'Squeak3.6' 'Stable' 'Code changes, may break compatibility').
#id -> '234753ae-5486-4343-87d8-2b282fa73101'.
#publisher -> 'Avi Bryant'.
#url ->'http://www.squeaksource.com/Seaside/Seaside2.50-avi.1.mcz'.
}.
{
#version -> '2.5b8'.
#created -> '14 March 2005 2:29:46 pm'.
#updated -> '20 April 2005 12:32:36 pm'.
#categories -> #('Squeak3.8' 'Alpha' 'Beta' 'Squeak3.7' 'Squeak3.6' 'Other license' 'Monticello' 'Code changes, but only internal' 'Code changes, may break compatibility').
#id -> 'b0da25c8-7cce-4c0a-9fab-74efb7ca0f27'.
#publisher -> 'Avi Bryant'.
#url ->'http://www.squeaksource.com/Seaside/Seaside2.5b8-avi.6.mcz'.
}.
{
#version -> '2.5b7'.
#created -> '22 January 2005 10:05:49 pm'.
#updated -> '12 February 2005 8:50:38 pm'.
#categories -> #('Code changes, may break compatibility' 'Squeak3.6' 'Alpha' 'Other license' 'Monticello' 'Squeak3.8' 'Code changes, but only internal' 'Beta' 'Squeak3.7').
#id -> '49715b8e-9526-429d-8034-a5ca1df844e7'.
#publisher -> 'Avi Bryant'.
#url ->'http://www.squeaksource.com/Seaside/Seaside2.5b7-avi.1.mcz'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>Magritte: (in category 'M') -----
Magritte: aVersion
self name: 'Magritte'.
self version: aVersion.
info summary: 'Powerful meta-description framework to build user-interfaces, reports, queries, persistency, etc.'.
info author: 'Lukas Renggli <renggli(a)iam.unibe.ch>'.
info owner: 'Lukas Renggli'.
info created: '23 June 2005 8:48:41 am'.
info updated: '10 January 2007 10:05:12 am'.
info description:
''.
info versions: {
{
+ #version -> '(1.0.17)'.
+ #created -> '29 September 2008 5:03:16 pm'.
+ #updated -> '29 September 2008 5:03:16 pm'.
+ #categories -> #().
+ #id -> 'b42bac2e-0bb2-4d50-9e33-b4004988a183'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
+ }.
+ {
#version -> '(1.0.16)'.
+ #created -> '24 August 2008 11:13:08 am'.
+ #updated -> '24 August 2008 11:13:08 am'.
- #created -> '14 May 2008 5:23:13 am'.
- #updated -> '14 May 2008 5:23:13 am'.
#categories -> #().
+ #id -> '370d7331-abe9-4d05-8017-5c92b382d8ec'.
- #id -> '7c736c69-6558-4baa-939f-7170ab5a9f92'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.14)'.
#created -> '12 September 2007 4:03:29 pm'.
#updated -> '12 September 2007 4:03:29 pm'.
#categories -> #().
#id -> '9d1acf95-c1db-4702-8302-7ab655972d0a'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.13)'.
#created -> '28 May 2007 9:29:52 am'.
#updated -> '28 May 2007 9:29:52 am'.
#categories -> #().
#id -> '00b6b5bd-c9e1-4bf6-8e7c-feeccef19138'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.12)'.
#created -> '24 February 2007 7:23:21 pm'.
#updated -> '24 February 2007 7:23:21 pm'.
#categories -> #().
#id -> 'baad55a4-49ca-46d2-9ed6-1dd866f0c787'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.11)'.
#created -> '11 January 2007 3:03:30 pm'.
#updated -> '11 January 2007 3:03:30 pm'.
#categories -> #().
#id -> '8d4e37e3-1392-4d9c-adaa-3eb1c8dfc33b'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.10)'.
#created -> '30 October 2006 9:06 pm'.
#updated -> '30 October 2006 9:06 pm'.
#categories -> #().
#id -> '486a1215-38e1-4ed0-bc2c-1a1f70b5a7a6'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.9)'.
#created -> '29 June 2006 10:46:13 pm'.
#updated -> '29 June 2006 10:46:13 pm'.
#categories -> #().
#id -> '8eeb3d52-3b01-4053-888f-e45f986072cb'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.7)'.
#created -> '17 March 2006 4:49:21 pm'.
#updated -> '17 March 2006 4:49:21 pm'.
#categories -> #().
#id -> '9518cea5-9670-4757-9fb5-408b39d304ef'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.6)'.
#created -> '7 January 2006 10:51 am'.
#updated -> '7 January 2006 10:51 am'.
#categories -> #().
#id -> 'ccc2d1d2-ef4f-4c20-81a5-757903b8c86c'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.5-alpha)'.
#created -> '24 November 2005 3:33:39 pm'.
#updated -> '24 November 2005 3:33:39 pm'.
#categories -> #().
#id -> '2d322cab-100d-4673-98d6-42e3e6d14513'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.4-alpha)'.
#created -> '17 November 2005 3:37:49 pm'.
#updated -> '17 November 2005 3:37:49 pm'.
#categories -> #().
#id -> 'a325fb3a-bb9d-4215-b2a7-0bd0122f12e2'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.3-alpha)'.
#created -> '7 November 2005 11:18:09 am'.
#updated -> '7 November 2005 11:18:09 am'.
#categories -> #().
#id -> '445a9e78-1f04-4ed7-aa57-5055568c6984'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.2-alpha)'.
#created -> '1 November 2005 7:21:57 pm'.
#updated -> '1 November 2005 7:21:57 pm'.
#categories -> #().
#id -> 'f9dee26e-d3eb-414f-8f51-0786a9ab09d2'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.1-alpha)'.
#created -> '28 October 2005 2:56:16 pm'.
#updated -> '31 October 2005 1:57:16 pm'.
#categories -> #('Squeak3.8' 'Bleeding edge' 'Not backwards compatible' 'MIT' 'No code changes' 'Alpha').
#id -> 'abc2ebfd-e92e-4273-81c7-99ce66bb0663'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
{
#version -> '(1.0.0-alpha)'.
#created -> '18 October 2005 11:26:10 pm'.
#updated -> '31 October 2005 1:57:39 pm'.
#categories -> #('Squeak3.8' 'Alpha' 'Not backwards compatible' 'MIT' 'No code changes').
#id -> '2bc638ae-00d0-4c83-9488-a4b7eabc28f6'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/771b44e8-e84b-4f54-8fee-e7cf5b4e4ee4/file…'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>Lisp: (in category 'L') -----
Lisp: aVersion
self name: 'Lisp'.
self version: aVersion.
info summary: 'A Lisp Interpreter for Squeak'.
info author: 'Nishihara Satoshi '.
+ info owner: 'NISHIHARA Satoshi'.
- info owner: 'Marcus Denker'.
info created: '14 February 2004 9:18:46 pm'.
+ info updated: '16 September 2008 9:32:32 pm'.
- info updated: '14 February 2004 9:18:46 pm'.
info description:
'GUI works only in MVC.
How to start
1) evaluate:
LispInterpreter open
+
+ Release 2
- or
-
- LispInterpreter fullOpen
- '.
+ GUI works in MVC and Morphic both.
+ On MVC, no longer ''Pluggable-Support'' needed.
+ MVC, Morphic version runs on 3.8 #6665 later. Morphic version developed Squeak 3.10.2-7179dev08.09.1 image.
+ '.
+
info versions: {
+ {
+ #version -> '(2)'.
+ #created -> '14 September 2008 10:21:35 pm'.
+ #updated -> '16 September 2008 9:33:10 pm'.
+ #categories -> #('Not backwards compatible' 'GPL' 'Beta' 'Squeak3.8' 'Squeak3.10').
+ #id -> 'a8d363d3-ba26-4395-9f01-ee22ab47edc7'.
+ #publisher -> 'nil'.
+ #url ->'http://map.squeak.org/accountbyid/36a7819b-ed87-483b-87d0-dc73d7defac4/file…'.
+ }.
{
#version -> '(1)'.
#created -> '14 February 2004 9:19:51 pm'.
#updated -> '14 February 2004 9:19:51 pm'.
#categories -> #().
#id -> '6dc785a2-3e2a-4171-b8f0-061d954b09fa'.
#publisher -> 'nil'.
#url ->'http://map.squeak.org/accountbyid/a6930213-b578-49b1-862e-228cc5ab39e7/file…'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>KomServices: (in category 'K') -----
KomServices: aVersion
self name: 'KomServices'.
self version: aVersion.
info summary: 'The Comanche Service Management Framework'.
info author: 'Stephen Pair'.
info owner: 'Göran Krampe'.
info created: '16 May 2003 5:07:21 am'.
info updated: '23 October 2007 1:59:48 pm'.
info description:
'Prerequisite packages: *DynamicBindings* and *NamedProcess* (which is included in Squeak 3.7 and later)
KomServices provides a framework for the creation and management of background processes. A generic Service class is provided for this purpose. Additionally, TcpService is provided for creating services that respond to inbound TCP connections.
===== Release History =====
Version 1.0:
- initial version, this package is bourne out of KomHttpServer and renames a few classes:
- ComancheService -> Service
- ComancheNetService -> TcpService
- the old ConnectionHandler is dropped in favor of a cleaner TcpListener.'.
info versions: {
{
+ #version -> '1.2a'.
+ #created -> '30 August 2008 3:33:08 pm'.
+ #updated -> '30 August 2008 3:53:03 pm'.
+ #categories -> #('Squeak3.8' 'Squeak3.9' 'SqueakL + MIT' 'Code changes, may break compatibility' 'Squeak3.7' 'Alpha' 'Squeak3.9-alpha' 'Monticello' 'Stable' 'No code changes').
+ #id -> 'eef6f105-ed30-4008-9809-4fd805a3c901'.
+ #publisher -> 'Giovanni Corriga'.
+ #url ->'http://www.squeaksource.com/KomHttpServer/KomServices-gc.18.mcz'.
+ }.
+ {
#version -> '1.1.3.1'.
#created -> '24 October 2007 9:32:10 am'.
#updated -> '5 November 2007 7:48:27 am'.
#categories -> #('Stable' 'Squeak3.9-alpha' 'Monticello' 'Squeak3.6' 'Squeak3.4' 'Squeak3.5' 'Squeak3.8' 'Squeak3.7' 'Code changes, but only bug fixes' 'SqueakL + MIT' 'No code changes').
#id -> 'ee05f534-bd66-4b1b-8b52-2db318958977'.
#publisher -> 'Giovanni Corriga'.
#url ->'http://www.squeaksource.com/KomHttpServer/KomServices-gc.12.mcz'.
}.
{
#version -> '1.1.2'.
#created -> '6 December 2005 9:56:40 pm'.
#updated -> '6 December 2005 9:56:40 pm'.
#categories -> #('Squeak3.8' 'Squeak3.7' 'Squeak3.5' 'SqueakL + MIT' 'No code changes' 'Stable' 'Squeak3.6' 'Monticello' 'Code changes, but only bug fixes' 'Squeak3.4').
#id -> '9905cac1-90bb-45db-81e9-79e2564cd206'.
#publisher -> 'Göran Krampe'.
#url ->'http://squeak.krampe.se/KomServices-gk.3.mcz'.
}.
{
#version -> '1.1.1'.
#created -> '30 November 2004 12:27:02 pm'.
#updated -> '30 November 2004 12:27:02 pm'.
#categories -> #('Squeak3.4' 'Squeak3.6' 'Code changes, but only bug fixes' 'No code changes' 'Squeak3.7' 'SqueakL + MIT' 'Monticello' 'Stable' 'Squeak3.5').
#id -> '80471ba4-a080-47ba-80f8-8859cddd1c16'.
#publisher -> 'Göran Krampe'.
#url ->'http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/file…'.
}.
{
#version -> '1.1'.
#created -> '4 November 2004 11:16:22 am'.
#updated -> '15 November 2004 2:30:08 pm'.
#categories -> #('Stable' 'SqueakL + MIT' 'Squeak3.7' 'Monticello' 'Squeak3.6' 'Squeak3.5' 'Squeak3.4' 'No code changes').
#id -> 'f16dfa23-35ba-4366-b1ce-7e2405e64a1d'.
#publisher -> 'Göran Krampe'.
#url ->'http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/file…'.
}.
{
#version -> '1.0'.
#created -> '16 May 2003 5:07:21 am'.
#updated -> '4 August 2004 4:09:26 pm'.
#categories -> #('Beta' 'SqueakL + MIT' 'Squeak3.6' 'Squeak3.5' 'Squeak3.4' 'No code changes' 'Squeak3.7').
#id -> '90ae0b21-eca8-4f5f-bd73-b76858057b36'.
#publisher -> 'Göran Krampe'.
#url ->'http://squeaklab.org/comanche/services/downloads/KomServices-1.0.sar'.
}.
}.
!
Item was changed:
----- Method: PackagesSqueakMapData>>LambdaMessageSend: (in category 'L') -----
LambdaMessageSend: aVersion
self name: 'LambdaMessageSend'.
self version: aVersion.
info summary: 'Functional programming in Squeak'.
info author: 'Stéphane Rollandin'.
info owner: 'Stéphane Rollandin'.
info created: '13 May 2006 12:34:31 pm'.
info updated: '24 February 2007 9:44:08 pm'.
info description:
'This package implements a specialized MessageSend subclass and an associated API for functional programming in Squeak.
.. see the test cases in FunctionalTalkTest for comprehensive documentation'.
info versions: {
+ {
+ #version -> '21'.
+ #created -> '16 September 2008 12:59:49 pm'.
+ #updated -> '16 September 2008 12:59:49 pm'.
+ #categories -> #('Only extensions, no changes' 'Not backwards compatible' 'SqueakL + MIT' 'Beta' 'Non official package' 'Squeak3.8' 'Simple filein' 'Squeak3.9').
+ #id -> '13066ebd-5d63-4a66-9b36-09943e38037f'.
+ #publisher -> 'Stéphane Rollandin'.
+ #url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
+ }.
{
#version -> '20'.
#created -> '7 May 2008 9:14:17 am'.
#updated -> '7 May 2008 9:14:17 am'.
#categories -> #('Squeak3.9' 'SqueakL + MIT' 'Not backwards compatible' 'Only extensions, no changes' 'Beta' 'Non official package' 'Squeak3.8' 'Simple filein').
#id -> '1fc192c1-b517-4549-98f5-f73b4d868652'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '19'.
#created -> '1 April 2008 4:00:02 pm'.
#updated -> '1 April 2008 4:00:02 pm'.
#categories -> #('Squeak3.9' 'SqueakL + MIT' 'Not backwards compatible' 'Only extensions, no changes' 'Beta' 'Non official package' 'Squeak3.8' 'Simple filein').
#id -> '419c2f47-afa0-499a-a9c6-975f9e032ed8'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '18'.
#created -> '11 March 2008 11:04:25 pm'.
#updated -> '11 March 2008 11:04:25 pm'.
#categories -> #('Not backwards compatible' 'Squeak3.8' 'Non official package' 'Beta' 'Simple filein' 'SqueakL + MIT' 'Only extensions, no changes' 'Squeak3.9').
#id -> '11be6123-ace1-47e8-a528-f3ffad519b7a'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '16'.
#created -> '13 March 2007 10:29:12 am'.
#updated -> '13 March 2007 10:29:12 am'.
#categories -> #('Beta' 'Not backwards compatible' 'Non official package' 'SqueakL + MIT' 'Squeak3.9' 'Simple filein' 'Squeak3.8' 'Only extensions, no changes').
#id -> 'ac72cb45-69f7-4450-b62a-4fc6c96d13d2'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '16'.
#created -> '10 March 2007 2:43:49 pm'.
#updated -> '10 March 2007 2:43:49 pm'.
#categories -> #('Beta' 'Not backwards compatible' 'Non official package' 'SqueakL + MIT' 'Squeak3.9' 'Simple filein' 'Squeak3.8' 'Only extensions, no changes').
#id -> 'e170845c-0108-4e6a-b4cc-9b57967a624f'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '15'.
#created -> '28 February 2007 1:27:15 pm'.
#updated -> '28 February 2007 1:28:08 pm'.
#categories -> #('Beta' 'Not backwards compatible' 'Non official package' 'SqueakL + MIT' 'Squeak3.9' 'Simple filein' 'Squeak3.8' 'Only extensions, no changes').
#id -> '6c515edc-e57f-447b-9881-541e36fc1c33'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '14'.
#created -> '24 February 2007 9:43:10 pm'.
#updated -> '24 February 2007 9:43:10 pm'.
#categories -> #('Beta' 'Not backwards compatible' 'Non official package' 'SqueakL + MIT' 'Squeak3.9' 'Simple filein' 'Squeak3.8' 'Only extensions, no changes').
#id -> '2a78b644-ee8e-4f7c-a12b-fd6f0ea3d56d'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '9'.
#created -> '15 February 2007 10:10:59 pm'.
#updated -> '15 February 2007 10:10:59 pm'.
#categories -> #('SqueakL + MIT' 'Only extensions, no changes' 'Not backwards compatible' 'Squeak3.8' 'Squeak3.9' 'Beta' 'Non official package' 'Simple filein').
#id -> '6539fb26-811c-4ed8-8412-79e2748e811a'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '8'.
#created -> '15 February 2007 4:47:37 pm'.
#updated -> '15 February 2007 4:49:25 pm'.
#categories -> #('SqueakL + MIT' 'Only extensions, no changes' 'Not backwards compatible' 'Squeak3.8' 'Squeak3.9' 'Beta' 'Non official package' 'Simple filein').
#id -> '453905bb-6d79-4648-b445-fd4d78ed6b2f'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '7'.
#created -> '20 January 2007 8:25:17 pm'.
#updated -> '20 January 2007 8:25:17 pm'.
#categories -> #('SqueakL + MIT' 'Only extensions, no changes' 'Not backwards compatible' 'Squeak3.8' 'Squeak3.9' 'Beta' 'Non official package' 'Simple filein').
#id -> '961907a2-b386-47e0-ad8b-ac11042b446c'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '6'.
#created -> '19 January 2007 9:44:58 pm'.
#updated -> '19 January 2007 10:02:10 pm'.
#categories -> #('SqueakL + MIT' 'Only extensions, no changes' 'Non official package' 'Squeak3.8' 'Squeak3.9' 'Beta' 'Simple filein' 'Not backwards compatible').
#id -> '106f622d-d0ab-4604-b601-d48cf2b6faa5'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '5'.
#created -> '23 May 2006 12:41:15 pm'.
#updated -> '23 May 2006 12:41:15 pm'.
#categories -> #('SqueakL + MIT' 'Not backwards compatible' 'Only extensions, no changes' 'Simple filein' 'Code changes, may break compatibility' 'Squeak3.8' 'Code changes, but only internal' 'No code changes' 'Beta' 'Non official package').
#id -> 'da424152-2c89-4f20-ad0b-a89371f4468a'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '4'.
#created -> '21 May 2006 3:31:35 pm'.
#updated -> '21 May 2006 3:31:35 pm'.
#categories -> #('SqueakL + MIT' 'Squeak3.8' 'Code changes, but only internal' 'No code changes' 'Only extensions, no changes' 'Simple filein' 'Beta' 'Non official package' 'Code changes, may break compatibility').
#id -> 'e7695b21-79aa-45ec-9459-862c565541c3'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '3'.
#created -> '16 May 2006 7:20:05 pm'.
#updated -> '16 May 2006 7:20:05 pm'.
#categories -> #('SqueakL + MIT' 'Squeak3.8' 'Code changes, but only internal' 'No code changes' 'Simple filein' 'Beta' 'Non official package' 'Code changes, may break compatibility').
#id -> '7d4ee596-89f5-4b6f-b661-7bfd5c24de52'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '2'.
#created -> '15 May 2006 8:45:02 am'.
#updated -> '15 May 2006 8:45:02 am'.
#categories -> #('SqueakL + MIT' 'Squeak3.8' 'No code changes' 'Simple filein' 'Beta' 'Non official package' 'Code changes, may break compatibility').
#id -> '64883f80-2d17-44e8-ad18-ab5a131e97b2'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
{
#version -> '1'.
#created -> '13 May 2006 12:42:10 pm'.
#updated -> '13 May 2006 12:42:10 pm'.
#categories -> #('SqueakL + MIT' 'Squeak3.8' 'No code changes' 'Simple filein' 'Non official package' 'Beta').
#id -> '3ace6f7d-b012-4608-8f33-5545dd45699d'.
#publisher -> 'Stéphane Rollandin'.
#url ->'http://map.squeak.org/accountbyid/5f9bef44-1fbb-4dd6-8f10-a69862ad5674/file…'.
}.
}.
!
1
0
30 Sep '08
A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-kph.229.mcz
==================== Summary ====================
Name: Installer-Core-kph.229
Author: kph
Time: 30 September 2008, 3:45:56 pm
UUID: 831357f2-18f8-4d30-9ccc-6a9969ea2774
Ancestors: Installer-Core-kph.228
fix
=============== Diff against Installer-Core-kph.228 ===============
Item was changed:
----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
webFindUrlToDownload
self class webSearchPath do: [ :pathSpec |
| potentialUrl readPathSpec |
readPathSpec := pathSpec value readStream.
potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
[ pageDataStream := self urlGet: potentialUrl ]
doWhileTrue: [
(pageDataStream notNil and: [ pageDataStream size > 0 ])
ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') ifFalse: [ pageDataStream reset. ^ potentialUrl ] ].
(Delay forSeconds: 2) wait.
+ true.
- false.
].
].
^nil
!
1
0
30 Sep '08
A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-kph.228.mcz
==================== Summary ====================
Name: Installer-Core-kph.228
Author: kph
Time: 30 September 2008, 12:58:21 pm
UUID: 99d6602f-0f9c-4c7e-a5ae-d7f4f1936784
Ancestors: Installer-Core-kph.227
fix
=============== Diff against Installer-Core-kph.227 ===============
Item was changed:
----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
webFindUrlToDownload
self class webSearchPath do: [ :pathSpec |
| potentialUrl readPathSpec |
readPathSpec := pathSpec value readStream.
potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
[ pageDataStream := self urlGet: potentialUrl ]
doWhileTrue: [
(pageDataStream notNil and: [ pageDataStream size > 0 ])
ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') ifFalse: [ pageDataStream reset. ^ potentialUrl ] ].
+
(Delay forSeconds: 2) wait.
+ false.
].
].
^nil
!
1
0
30 Sep '08
A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-kph.227.mcz
==================== Summary ====================
Name: Installer-Core-kph.227
Author: kph
Time: 30 September 2008, 12:56:37 pm
UUID: 23c9fd18-91eb-4433-9800-9c486378a846
Ancestors: Installer-Core-kph.226
again attempt to work around pbwiki speed restrictions
=============== Diff against Installer-Core-kph.226 ===============
Item was changed:
----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
webFindUrlToDownload
self class webSearchPath do: [ :pathSpec |
| potentialUrl readPathSpec |
readPathSpec := pathSpec value readStream.
potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
[ pageDataStream := self urlGet: potentialUrl ]
doWhileTrue: [
+ (pageDataStream notNil and: [ pageDataStream size > 0 ])
+ ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') ifFalse: [ pageDataStream reset. ^ potentialUrl ] ].
- ((pageDataStream notNil and: [ pageDataStream size > 0 ])
- ifTrue: [ pageDataStream contents includesSubString: 'Please slow down a bit' ]) ifFalse: [ pageDataStream reset. ^ potentialUrl ].
(Delay forSeconds: 2) wait.
].
].
^nil
!
1
0
30 Sep '08
A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-kph.226.mcz
==================== Summary ====================
Name: Installer-Core-kph.226
Author: kph
Time: 30 September 2008, 12:51:35 pm
UUID: 1bef352d-18ed-405a-8a59-f18d2b02233d
Ancestors: Installer-Core-dc.225
attempt to work around pbwiki errors
=============== Diff against Installer-Core-dc.225 ===============
Item was changed:
----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
webFindUrlToDownload
self class webSearchPath do: [ :pathSpec |
| potentialUrl readPathSpec |
readPathSpec := pathSpec value readStream.
potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]).
+ [ pageDataStream := self urlGet: potentialUrl ]
+
+ doWhileTrue: [
+
+ ((pageDataStream notNil and: [ pageDataStream size > 0 ])
+ ifTrue: [ pageDataStream contents includesSubString: 'Please slow down a bit' ]) ifFalse: [ pageDataStream reset. ^ potentialUrl ].
+ (Delay forSeconds: 2) wait.
+ ].
+
- pageDataStream := self urlGet: potentialUrl.
- (pageDataStream notNil and: [ pageDataStream size > 0 ]) ifTrue: [ ^potentialUrl ]
].
^nil
!
Item was changed:
Object subclass: #Installer
instanceVariableNames: 'sm wsm mc ma url root command markers project package bug desc answers packages messagesToSuppress pageDataStream date universe afile sake'
+ classVariableNames: 'WebSearchPath SkipLoadingTests Fixes Sake Entities ValidationBlock InstallerBindings Remembered LastUniUpdate IsSetToTrapErrors'
- classVariableNames: 'WebSearchPath SkipLoadingTests Fixes ValidationBlock Entities InstallerBindings Sake Remembered LastUniUpdate IsSetToTrapErrors'
poolDictionaries: ''
category: 'Installer-Core'!
!Installer commentStamp: 'kph 12/19/2007 14:42' prior: 0!
Documentation now available at http://installer.pbwiki.com/Installer
!
1
0
28 Sep '08
A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-dc.225.mcz
==================== Summary ====================
Name: Installer-Core-dc.225
Author: dc
Time: 28 September 2008, 6:15:44 pm
UUID: cc0ac09b-b804-4b43-8130-1e2ddebbf623
Ancestors: Installer-Core-kph.224
- Only update the LastUniUpdate variable after updating Universe. The previous behavior could prevent the update if #uniUpdate is called often enough.
=============== Diff against Installer-Core-kph.224 ===============
Item was changed:
----- Method: Installer>>uniUpdate (in category 'universes') -----
uniUpdate
+ (LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ])
+ ifTrue: [universe requestPackageList.
+ LastUniUpdate := DateAndTime now]!
-
-
- (LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ]) ifTrue: [ universe requestPackageList ].
-
- LastUniUpdate := DateAndTime now.!
Item was changed:
Object subclass: #Installer
instanceVariableNames: 'sm wsm mc ma url root command markers project package bug desc answers packages messagesToSuppress pageDataStream date universe afile sake'
+ classVariableNames: 'WebSearchPath SkipLoadingTests Fixes ValidationBlock Entities InstallerBindings Sake Remembered LastUniUpdate IsSetToTrapErrors'
- classVariableNames: 'WebSearchPath SkipLoadingTests Fixes Sake Entities ValidationBlock InstallerBindings Remembered LastUniUpdate IsSetToTrapErrors'
poolDictionaries: ''
category: 'Installer-Core'!
!Installer commentStamp: 'kph 12/19/2007 14:42' prior: 0!
Documentation now available at http://installer.pbwiki.com/Installer
!
1
0
28 Sep '08
A new version of Sake-Packages was added to project Packages:
http://www.squeaksource.com/Packages/Sake-Packages-dc.3.mcz
==================== Summary ====================
Name: Sake-Packages-dc.3
Author: dc
Time: 28 September 2008, 5:17:05 pm
UUID: b8ae1e1e-220a-4644-a2bc-3b29f1e9ace1
Ancestors: Sake-Packages-kph.2
- Add a class for Pharo
=============== Diff against Sake-Packages-kph.2 ===============
Item was added:
+ PackagesDevU subclass: #PackagesPharo01
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Sake-Packages'!
1
0
28 Sep '08
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@100 corner: 200@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@100 corner: 200@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@100 corner: 200@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@100 corner: 200@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@2 . 3}'.
self assertCode: '{2@3}' print: '{2@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@10 corner: 20@20 . 100@100 corner: 200@200}' print: '{10@10 corner: 20@20 . 100@100 corner: 200@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@0.
pt2 := pt1.
pt3 := 100@100.
pt1 become: pt3.
self assert: pt2 = (100@100).
self assert: pt3 = (0@0).
self assert: pt1 = (100@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@0.
pt2 := pt1.
pt3 := 100@100.
pt1 becomeForward: pt3.
self assert: pt2 = (100@100).
self assert: pt3 == pt2.
self assert: pt1 = (100@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)!
2
1