smalltalk
/
osmo-st-all
Archived
1
0
Fork 0
Code Releases Activity

Add 'grease/' from commit '131f4216188310992db37836e0ea248a9a152406' 

git-subtree-dir: grease
git-subtree-mainline: 9cda4fc259
git-subtree-split: 131f421618
This commit is contained in:
Holger Hans Peter Freyther 2014-06-04 15:55:12 +02:00
parent 9cda4fc259 131f421618
commit ab8662178b
65 changed files with 8615 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
grease/Core/Collections/GROrderedMultiMap.st Normal file
View File

@ -0,0 +1,48 @@
GRSmallDictionary subclass: GROrderedMultiMap [
<comment: 'I am an implementation of an ordered multi-map. I allow multiple values to be associated with the same key and maintain the order of addition. #at: and its derivatives all operate on the first matching key, while #allAt: returns the complete list of values for a key in the order they were added.'>
<category: 'Grease-Core-Collections'>
add: anAssociation [
<category: 'accessing'>
self privateAt: anAssociation key put: anAssociation value.
^anAssociation
]
allAt: aKey [
<category: 'accessing'>
^Array streamContents: [:stream |
1 to: size do: [:index |
(keys at: index) = aKey ifTrue: [
stream nextPut: (values at: index)]]]
]
allAt: aKey ifAbsent: absentBlock [
<category: 'accessing'>
| results |
results := self allAt: aKey.
^results isEmpty ifTrue: [absentBlock value] ifFalse: [results]
]
at: aKey add: aValue [
"Add an association between aKey and aValue. Do not replace existing
values with the same key."
<category: 'accessing'>
^self privateAt: aKey put: aValue
]
removeKey: aKey ifAbsent: aBlock [
"Remove aKey from the receiver, evaluate aBlock if the element is missing."
"This is inefficient and could be optimized."
<category: 'accessing'>
| removed |
removed := Array streamContents: [:stream | | index |
[(index := self findIndexFor: aKey) = 0]
whileFalse: [stream nextPut: (self removeIndex: index)]].
^removed isEmpty ifTrue: [aBlock value] ifFalse: [removed]
]
]

244
grease/Core/Collections/GRSmallDictionary.st Normal file
View File

@ -0,0 +1,244 @@
GRObject subclass: GRSmallDictionary [
| size keys values |
<category: 'Grease-Core-Collections'>
<comment: 'I am an implementation of a dictionary. Compared to other dictionaries I am very efficient for small sizes, speed- and space-wise. I also remember the order in which elements are added, some of my users might depend on that. My implementation features some ideas from the RefactoringBrowser.'>
GRSmallDictionary class [
new [
<category: 'instance-creation'>
^self new: 3
]
new: anInteger [
<category: 'instance-creation'>
^self basicNew initialize: anInteger
]
withAll: aCollection [
<category: 'instance creation'>
^self new addAll: aCollection; yourself
]
]
initialize: anInteger [
<category: 'initialization'>
size := 0.
keys := Array new: anInteger.
values := Array new: anInteger
]
isEmpty [
<category: 'testing'>
^size = 0
]
isDictionary [
<category: 'testing'>
^true
]
isCollection [
<category: 'testing'>
^true
]
add: anAssociation [
<category: 'accessing'>
self at: anAssociation key put: anAssociation value.
^anAssociation
]
addAll: aDictionary [
<category: 'accessing'>
aDictionary keysAndValuesDo: [ :key :value | self add: key -> value ].
^aDictionary
]
at: aKey [
"Answer the value associated with aKey. Raise an exception, if no such key is defined."
<category: 'accessing'>
^self at: aKey ifAbsent: [self errorKeyNotFound]
]
at: aKey ifAbsent: aBlock [
"Answer the value associated with aKey. Evaluate aBlock, if no such key is defined."
<category: 'accessing'>
| index |
index := self findIndexFor: aKey.
^index = 0 ifFalse: [values at: index] ifTrue: [aBlock value]
]
at: aKey ifAbsentPut: aBlock [
"Answer the value associated with aKey. Evaluate aBlock, if no such key is defined and store the return value."
<category: 'accessing'>
| index |
index := self findIndexFor: aKey.
^index = 0
ifFalse: [values at: index]
ifTrue: [self privateAt: aKey put: aBlock value]
]
at: aKey ifPresent: aBlock [
"Lookup aKey in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."
<category: 'accessing'>
| index |
index := self findIndexFor: aKey.
^index = 0 ifFalse: [aBlock value: (values at: index)]
]
at: aKey put: aValue [
"Set the value of aKey to be aValue."
<category: 'accessing'>
| index |
index := self findIndexFor: aKey.
^index = 0
ifFalse: [values at: index put: aValue]
ifTrue: [self privateAt: aKey put: aValue]
]
includesKey: aKey [
"Answer whether the receiver has a key equal to aKey."
<category: 'testing'>
^(self findIndexFor: aKey) ~= 0
]
keys [
<category: 'enumerating'>
^keys copyFrom: 1 to: size
]
associations [
"Answer a Collection containing the receiver's associations."
<category: 'accessing'>
| result |
result := WriteStream on: (Array new: self size).
self associationsDo: [:assoc | result nextPut: assoc].
^result contents
]
associationsDo: aBlock [
<category: 'enumerating'>
self keysAndValuesDo: [:key :value | aBlock value: key -> value]
]
do: aBlock [
<category: 'enumerating'>
1 to: size do: [ :index | aBlock value: (values at: index) ]
]
keysAndValuesDo: aBlock [
<category: 'enumerating'>
1 to: size
do: [:index | aBlock value: (keys at: index) value: (values at: index)]
]
postCopy [
<category: 'copying'>
super postCopy.
keys := keys copy.
values := values copy
]
size [
<category: 'accessing'>
^size
]
grow [
<category: 'private'>
| newKeys newValues |
newKeys := Array new: 2 * size.
newValues := Array new: 2 * size.
1 to: size
do:
[:index |
newKeys at: index put: (keys at: index).
newValues at: index put: (values at: index)].
keys := newKeys.
values := newValues
]
errorKeyNotFound [
<category: 'private'>
self error: 'Key not found'
]
findIndexFor: aKey [
<category: 'private'>
1 to: size do: [:index | (keys at: index) = aKey ifTrue: [^index]].
^0
]
removeIndex: index [
<category: 'private'>
| value |
value := values at: index.
index to: size - 1 do:
[ :i |
keys at: i put: (keys at: i + 1).
values at: i put: (values at: i + 1) ].
keys at: size put: nil.
values at: size put: nil.
size := size - 1.
^ value
]
privateAt: aKey put: aValue [
<category: 'private'>
size = keys size ifTrue: [self grow].
keys at: (size := size + 1) put: aKey.
^values at: size put: aValue
]
values [
<category: 'enumerating'>
^values copyFrom: 1 to: size
]
valuesDo: aBlock [
<category: 'enumerating'>
1 to: size do: [:index | aBlock value: (values at: index)]
]
removeKey: aKey [
"Remove aKey from the receiver, raise an exception if the element is missing."
<category: 'accessing'>
^self removeKey: aKey ifAbsent: [self errorKeyNotFound]
]
keysDo: aBlock [
<category: 'enumerating'>
1 to: size do: [:each | aBlock value: (keys at: each)]
]
removeKey: aKey ifAbsent: aBlock [
"Remove aKey from the receiver, evaluate aBlock if the element is missing."
<category: 'accessing'>
| index value |
index := self findIndexFor: aKey.
index = 0 ifTrue: [^aBlock value].
value := values at: index.
index to: size - 1
do:
[:i |
keys at: i put: (keys at: i + 1).
values at: i put: (values at: i + 1)].
keys at: size put: nil.
values at: size put: nil.
size := size - 1.
^value
]
]

53
grease/Core/Exceptions.st Normal file
View File

@ -0,0 +1,53 @@
Error subclass: GRError [
<category: 'Grease-Core-Exceptions'>
<comment: 'This class provides consistent initialization and exception signaling behaviour across platforms. All platforms must provide the ANSI-standard signaling protocol on this class. #signal: can therefore be safely called on any subclass.
Packages that are using Seaside-Platform should usually subclass WAPlatformError instead of Error.'>
GRError class >> new [
<category: 'instance creation'>
^super new initialize
]
initialize [
<category: 'initialization'>
]
]
Notification subclass: GRNotification [
<category: 'Grease-Core-Exceptions'>
<comment: 'This class provides consistent initialization and exception signaling behaviour across platforms. All platforms must provide the ANSI-standard signaling protocol on this class. #signal: can therefore be safely called on any subclass.
Packages that are using Seaside-Platform should usually subclass WAPlatformNotification instead of Notification.'>
GRNotification class >> new [
<category: 'instance creation'>
^super new initialize
]
initialize [
<category: 'initialization'>
]
]
GRNotification subclass: GRDeprecatedApiNotification [
| details |
<category: 'Grease-Core-Exceptions'>
<comment: 'This notification is signaled whenever a deprecated message is sent.
see WAObject>>#seasideDeprecatedApi:details: '>
details [
<category: 'accessing'>
^details
]
details: anObject [
<category: 'accessing'>
details := anObject
]
]

222
grease/Core/Extensions.st Normal file
View File

@ -0,0 +1,222 @@
Object extend [
greaseDeprecatedApi: apiString details: detailsString [
<category: '*Grease-Core'>
Grease.GRDeprecatedApiNotification new
details: detailsString;
signal: apiString
]
isCollection [
<category: '*Grease-Core'>
^false
]
greaseString [
<category: '*Grease-Core'>
^self printString
]
]
String extend [
greaseString [
<category: '*Grease-Core'>
^self
]
excerpt: aString [
<category: '*Grease-Core'>
"Answer an excerpt of the receiver that matches the first occurence of aString. If aString isn't found, nil is answered."
^self excerpt: aString radius: 100
]
excerpt: aString radius: anInteger [
<category: '*Grease-Core'>
"Answer an excerpt of the receiver that matches the first occurence of aString.
The radius anInteger expands the excerpt on each side of the first occurrence by the number of characters defined in radius.
If aString isn't found, nil is answered."
^self excerpt: aString radius: anInteger ellipsis: '...'
]
excerpt: aString radius: anInteger ellipsis: anEllipsisString [
<category: '*Grease-Core'>
"Answer an excerpt of the receiver that matches the first occurence of aString.
The radius anInteger expands the excerpt on each side of the first occurrence by the number of characters defined in radius.
If aString isn't found, nil is answered."
| index start stop |
(aString isEmpty or: [ (index := self indexOfSubCollection: aString) = 0 ])
ifTrue: [ ^ nil ].
start := index - anInteger max: 1.
stop := index + anInteger + aString size - 1 min: self size.
^(start > 1 ifTrue: [ anEllipsisString ] ifFalse: [ '' ]) ,
(self copyFrom: start to: stop) ,
(stop < self size ifTrue: [ anEllipsisString ] ifFalse: [ '' ])
]
greaseInteger [
<category: '*Grease-Core'>
"Convert the receiver to an integer, answer nil if this is not a number."
| number stream negated char |
number := nil.
stream := self readStream.
negated := stream peek = $-.
negated ifTrue: [ stream next ].
[ stream atEnd not and: [ (char := stream next) isDigit ] ] whileTrue:
[ number := (number isNil
ifTrue: [ 0 ]
ifFalse: [ 10 * number ]) + (char greaseInteger - $0 greaseInteger) ].
^(number isNil or: [ negated not ])
ifFalse: [ number negated ]
ifTrue: [ number ]
]
pluralize [
<category: '*Grease-Core'>
^ Grease.GRInflector pluralize: self
]
print: anObject on: aStream [
<category: '*Grease-Core'>
aStream nextPutAll: self
]
trimBoth [
<category: '*Grease-Core'>
"Trim separators from both sides of the receiving string."
^ self trimBoth: [ :char | char isSeparator ]
]
trimBoth: aBlock [
<category: '*Grease-Core'>
"Trim characters satisfying the condition given in aBlock from both sides of the receiving string."
^ self trimLeft: aBlock right: aBlock
]
trimLeft [
<category: '*Grease-Core'>
"Trim separators from the left side of the receiving string."
^ self trimLeft: [ :char | char isSeparator ]
]
trimLeft: aBlock [
<category: '*Grease-Core'>
"Trim characters satisfying the condition given in aBlock from the left side of the receiving string."
^ self trimLeft: aBlock right: [ :char | false ]
]
trimLeft: aLeftBlock right: aRightBlock [
<category: '*Grease-Core'>
"Trim characters satisfying the condition given in aLeftBlock from the left side and aRightBlock from the right sides of the receiving string."
| left right |
left := 1.
right := self size.
[ left <= right and: [ aLeftBlock value: (self at: left) ] ]
whileTrue: [ left := left + 1 ].
[ left <= right and: [ aRightBlock value: (self at: right) ] ]
whileTrue: [ right := right - 1 ].
^ self copyFrom: left to: right
]
trimRight [
<category: '*Grease-Core'>
"Trim separators from the right side of the receiving string."
^ self trimRight: [ :char | char isSeparator ]
]
trimRight: aBlock [
<category: '*Grease-Core'>
"Trim characters satisfying the condition given in aBlock from the right side of the receiving string."
^ self trimLeft: [ :char | false ] right: aBlock
]
truncate [
<category: '*Grease-Core'>
"Truncate the receiver to 30 characters."
^ self truncate: 30
]
truncate: anInteger [
<category: '*Grease-Core'>
"Truncate the receiver to anInteger characters."
^ self truncate: anInteger ellipsis: '...'
]
truncate: anInteger ellipsis: aString [
<category: '*Grease-Core'>
"Truncate the receiver to anInteger characters and append aString as ellipsis if necessary."
^ anInteger < self size
ifTrue: [ (self copyFrom: 1 to: anInteger) , aString ]
ifFalse: [ self copy ]
]
]
Symbol extend [
greaseString [
<category: '*Grease-Core'>
^self asString
]
]
Number extend [
greaseInteger [
<category: '*Grease-Core'>
"Answer an integer of the receiver, in our case we simply truncate the number."
^ self truncated
]
]
Integer extend [
greaseInteger [
<category: '*Grease-Core'>
^ self
]
pluralize: aSingularString [
<category: '*Grease-Core'>
^ self
pluralize: aSingularString
with: (Grease.GRInflector pluralize: aSingularString)
]
pluralize: aSingularString with: aPluralString [
<category: '*Grease-Core'>
^ self printString , ' ' , (self abs = 1 ifTrue: [ aSingularString ] ifFalse: [ aPluralString ])
]
]
Character extend [
print: anObject on: aStream [
<category: '*Grease-Core'>
aStream nextPut: self
]
greaseString [
<category: '*Grease-Core'>
^self asString
]
]
UndefinedObject extend [
print: anObject on: aStream [
<category: '*Grease-Core'>
]
]

32
grease/Core/GRObject.st Normal file
View File

@ -0,0 +1,32 @@
Object subclass: GRObject [
<category: 'Grease-Core'>
<comment: 'A common superclass that ensures consistent initialization behaviour on all platforms and provides #error: methods that signal an instance of WAPlatformError.
Packages that are using Seaside-Platform should normally subclass WAPlatformObject instead of Object.'>
GRObject class >> defaultErrorClass [
<category: 'error handling'>
^GRError
]
GRObject class >> error: aString [
<category: 'error handling'>
^self defaultErrorClass signal: aString
]
GRObject class >> new [
<category: 'instance creation'>
^self basicNew initialize
]
error: aString [
<category: 'error handling'>
^self class error: aString
]
initialize [
<category: 'initialization'>
]
]

168
grease/Core/GRPackage.st Normal file
View File

@ -0,0 +1,168 @@
GRObject subclass: GRPackage [
| name description dependencies license url |
<comment: nil>
<category: 'Grease-Core'>
GRPackage class >> greaseTestsCore [
<category: '*grease-tests-core'>
^(self new)
name: 'Grease-Tests-Core';
description: 'Unit tests for the package Grease-Core.';
addDependency: 'Grease-Core';
url: #seasideUrl;
yourself
]
GRPackage class >> greaseCore [
<category: 'accessing'>
^(self new)
name: 'Grease-Core';
description: 'The main package of the Grease compatibility layer.';
url: #seasideUrl;
yourself
]
GRPackage class >> packages [
"Answer a list of all registered packages.
A package is registered by adding a class extension to the receiving class answering an instance of the receiving class."
<category: 'querying'>
| packages package |
packages := Dictionary new.
self class selectors do:
[:each |
(each numArgs = 0 and: [each ~= #packages])
ifTrue:
[package := self perform: each.
packages at: package name put: package]].
packages do: [:each | each resolveWith: packages].
^packages values
]
initialize [
<category: 'initialization'>
super initialize.
dependencies := OrderedCollection new.
license := #MIT
]
description [
"Answer a short description of the package."
<category: 'accessing'>
^description
]
description: aString [
<category: 'accessing'>
description := aString
]
license [
"Answer the current license of this package, by default MIT is used."
<category: 'accessing'>
^license
]
license: aSymbol [
<category: 'accessing'>
license := aSymbol
]
name [
"Answer the name of the package. This string should be useable to identify the platform specific native package object, e.g. the Monticello package name."
<category: 'accessing'>
^name
]
name: aString [
<category: 'accessing'>
name := aString
]
url [
"Answer the base-URL of the package. This string is only meaningful for platforms that can directly access Monticello repositories."
<category: 'accessing'>
^url isSymbol ifTrue: [self perform: url] ifFalse: [url]
]
url: aStringOrSymbol [
"Set the base-URL of the package, or a symbol referring to a method in this class that answers the URL. This setting is only meaningful for platforms that can directly access Monticello repositories."
<category: 'accessing'>
url := aStringOrSymbol
]
addDependency: aString [
<category: 'dependencies'>
dependencies add: aString
]
allDependencies [
"Answer all dependencies on which this package depends."
<category: 'dependencies'>
^self addDependenciesTo: OrderedCollection new
]
dependencies [
"Return a collection of package names on which this package depends."
<category: 'dependencies'>
^dependencies
]
resolveWith: aDictionary [
<category: 'dependencies'>
dependencies := dependencies collect:
[:each |
aDictionary at: each
ifAbsent:
[self error: self name printString , ' depends on unknown package '
, each printString]]
]
printOn: aStream [
<category: 'printing'>
super printOn: aStream.
aStream
nextPut: $(;
nextPutAll: self name;
nextPut: $)
]
isLGPL [
<category: 'testing'>
^self license = #LGPL
]
isMIT [
<category: 'testing'>
^self license = #MIT
]
addDependenciesTo: aCollection [
<category: 'private'>
(aCollection includes: self)
ifFalse:
[self dependencies do: [:each | each addDependenciesTo: aCollection].
aCollection add: self].
^aCollection
]
seasideLGPLUrl [
<category: 'accessing-repositories'>
^'http://www.squeaksource.com/Seaside30LGPL'
]
seasideUrl [
<category: 'accessing-repositories'>
^'http://www.squeaksource.com/Seaside30'
]
]

259
grease/Core/GRPlatform.st Normal file
View File

@ -0,0 +1,259 @@
GRObject subclass: GRPlatform [
<comment: 'The abstract platform implementation. Each platform should provide a subclass implementing any abstract methods and overriding any other methods as necessary.
Default implementations should be provided here when possible/useful but default implementations MUST be valid on ALL PLATFORMS so it is rarely practical. VA Smalltalk flags sends of uknown messages so even these must be known to exist on all platforms.
Common cases where default implementations *are* appropriate are where there is a standard implementation that is valid on all platforms but one or more platforms have an additional, optimized implementation that should be used instead.
All classes and methods used by methods of this class should be either:
+ included in the Seaside-Platform package;
+ defined by the ANSI Smalltalk standard; or
+ (not ideal) referenced via ''Smalltalk at: #ClassName''.'>
<category: 'Grease-Core'>
Current := nil.
GRPlatform class >> current [
<category: 'registration'>
^Current
]
GRPlatform class >> current: aPlatform [
<category: 'registration'>
Current := aPlatform
]
GRPlatform class >> select [
<category: 'registration'>
GRPlatform current: self new
]
GRPlatform class >> unselect [
<category: 'registration'>
GRPlatform current class = self ifTrue: [GRPlatform current: nil]
]
secureHashFor: aString [
<category: 'cryptography'>
self subclassResponsibility
]
base64Decode: aString [
<category: 'encoding'>
self subclassResponsibility
]
openDebuggerOn: anError [
<category: 'exceptions'>
self subclassResponsibility
]
stackDepth [
<category: 'exceptions'>
self subclassResponsibility
]
newRandom [
"Answers the random number generator to be used to create session and continuation keys. Make sure it is seeded. The only methods that will be sent to it are:
#nextInt: - should answer a random integer in the interval [1, anInteger]
#randomFrom: - should answer a random element from the given collection
Make sure that both methods are safe under heavy concurrent load.
Used by Gemstone/S traditional Randoms which cannot be persisted.
Used by Squeak to use a secure random when avaiable."
<category: 'factory'>
self subclassResponsibility
]
readWriteByteStream [
"Return a ReadWriteStream on a ByteArray that stores integers 0..255
^ReadWriteStream on: ByteArray new
"
<category: 'factory'>
^self subclassResponsibility
]
readWriteCharacterStream [
"Return a ReadWriteStream on a String that stores characters
^ReadWriteStream on: String new
"
<category: 'factory'>
^self subclassResponsibility
]
reducedConflictDictionary [
"used by Gemstone/S reduced conflict classes that can be used to avoid transaction conflicts"
<category: 'factory'>
^Dictionary
]
semaphoreClass [
"used by Gemstone/S traditional Semaphores which cannot be persisted"
<category: 'factory'>
self subclassResponsibility
]
weakDictionaryOfSize: aNumber [
<category: 'factory'>
self subclassResponsibility
]
asMethodReturningByteArray: aByteArrayOrString named: aSymbol [
"Generates the source of a method named aSymbol that returns aByteArrayOrString as a ByteArray"
<category: 'file library'>
self subclassResponsibility
]
compile: aString into: aClass classified: aSymbol [
"The trick here is to be as silently a possible so that the package is not marked dirty when running WAFileLibrary test.
This also makes running tests much faster."
<category: 'file library'>
self subclassResponsibility
]
contentsOfFile: aString binary: aBoolean [
<category: 'file library'>
self subclassResponsibility
]
convertToSmalltalkNewlines: aString [
"convert any line endings (CR, CRLF, LF) to CR"
<category: 'file library'>
self subclassResponsibility
]
ensureExistenceOfFolder: aString [
"creates a folder named aString in the image directory"
<category: 'file library'>
self subclassResponsibility
]
filesIn: aPathString [
"Return a collection of absolute paths for all the files (no directories) in the directory given by aPathString
must not include file names that start with ."
<category: 'file library'>
self subclassResponsibility
]
localNameOf: aFilename [
"Answers the local name of a file indentified by an absolute file path.
Eg.
If the platform is Windwos and aFilename is 'C:\Windows\win32.dll' then it would answer 'win32.dll'.
If the platform is Unix and aFilename is '/usr/bin/vim' then it would answer 'vim'."
<category: 'file library'>
self subclassResponsibility
]
removeSelector: aSymbol from: aClass [
<category: 'file library'>
self subclassResponsibility
]
write: aStringOrByteArray toFile: aFileNameString inFolder: aFolderString [
"writes aStringOrByteArray to a file named aFilenameString in the folder aFolderString"
<category: 'file library'>
self subclassResponsibility
]
isProcessTerminated: aProcess [
"Return a boolean indicating whether aProcess has been terminated."
<category: 'processes'>
self subclassResponsibility
]
terminateProcess: aProcess [
"Permanently terminate the process, unwinding first to execute #ensure: and #ifCurtailed: blocks."
<category: 'processes'>
self subclassResponsibility
]
addToShutDownList: anObject [
"Add anObject to the shutdown-list of the system. On shutdown the message #shutDown will be sent to anObject."
<category: 'startup'>
self subclassResponsibility
]
addToStartUpList: anObject [
"Add anObject to the startup-list of the system. On startup the message #startUp will be sent to anObject."
<category: 'startup'>
self subclassResponsibility
]
removeFromShutDownList: anObject [
"Remove anObject from the shutdown list in the system."
<category: 'startup'>
self subclassResponsibility
]
removeFromStartUpList: anObject [
"Remove anObject from the startup list in the system."
<category: 'startup'>
self subclassResponsibility
]
newline [
"Answer the system's default newline character (sequence)."
<category: 'accessing'>
self subclsasResponsibility
]
doTransaction: aBlock [
"for Gemstone/S compatibility
http://gemstonesoup.wordpress.com/2007/05/10/porting-application-specific-seaside-threads-to-gemstone/
use when modifying an object from an outside thread"
<category: 'transactions'>
^aBlock value
]
label [
"Answer a descriptive label string for the platform implementation"
<category: 'version info'>
self subclassResponsibility
]
version [
"Answer the Grease version"
<category: 'version info'>
^(GRVersion major: 1 minor: 0)
beAlpha: 6;
yourself
]
versionString [
<category: 'version info'>
^String streamContents:
[:stream |
stream
nextPutAll: self version greaseString;
nextPutAll: ' (';
nextPutAll: self label;
nextPut: $)]
]
]

190
grease/Core/GRVersion.st Normal file
View File

@ -0,0 +1,190 @@
GRObject subclass: GRVersion [
| major minor revision stageLabel stageNumber |
<comment: nil>
<category: 'Grease-Core'>
GRVersion class >> major: majorInteger [
<category: 'instance creation'>
^self major: majorInteger minor: nil
]
GRVersion class >> major: majorInteger minor: minorInteger [
<category: 'instance creation'>
^self
major: majorInteger
minor: minorInteger
revision: nil
]
GRVersion class >> major: majorInteger minor: minorInteger revision: revisionInteger [
<category: 'instance creation'>
^(self basicNew)
initializeWithMajor: majorInteger
minor: minorInteger
revision: revisionInteger;
yourself
]
GRVersion class >> new [
<category: 'instance creation'>
^self major: 1
]
initializeWithMajor: majorInteger minor: minorInteger revision: revisionInteger [
<category: 'initialization'>
self initialize.
major := majorInteger.
minor := minorInteger.
revision := revisionInteger
]
< otherVersion [
<category: 'comparing'>
major < otherVersion major ifTrue: [^true].
otherVersion major < major ifTrue: [^false].
(minor ifNil: [0]) < (otherVersion minor ifNil: [0]) ifTrue: [^true].
(otherVersion minor ifNil: [0]) < (minor ifNil: [0]) ifTrue: [^false].
(revision ifNil: [0]) < (otherVersion revision ifNil: [0]) ifTrue: [^true].
(otherVersion revision ifNil: [0]) < (revision ifNil: [0])
ifTrue: [^false].
stageLabel = otherVersion stage
ifTrue: [^(stageNumber ifNil: [1]) < (otherVersion stageNumber ifNil: [1])].
stageLabel isNil ifTrue: [^false].
otherVersion stage isNil ifTrue: [^true].
^stageLabel < otherVersion stage
]
<= otherVersion [
<category: 'comparing'>
^(self > otherVersion) not
]
= otherVersion [
<category: 'comparing'>
^major = otherVersion major and:
[(minor ifNil: [0]) = (otherVersion minor ifNil: [0]) and:
[(revision ifNil: [0]) = (otherVersion revision ifNil: [0]) and:
[stageLabel = otherVersion stage
and: [(stageNumber ifNil: [1]) = (otherVersion stageNumber ifNil: [1])]]]]
]
> otherVersion [
<category: 'comparing'>
^otherVersion < self
]
>= otherVersion [
<category: 'comparing'>
^(self < otherVersion) not
]
hash [
<category: 'comparing'>
^(major hash bitXor: minor hash) bitXor: revision hash
]
beAlpha [
<category: 'convenience'>
self beAlpha: nil
]
beAlpha: anInteger [
<category: 'convenience'>
self stage: #alpha number: anInteger
]
beBeta [
<category: 'convenience'>
self beBeta: nil
]
beBeta: anInteger [
<category: 'convenience'>
self stage: #beta number: anInteger
]
beFinal [
<category: 'convenience'>
self stage: nil number: nil
]
greaseString [
<category: 'converting'>
^String streamContents:
[:stream |
stream nextPutAll: major greaseString.
stream nextPut: $..
stream nextPutAll: (minor ifNil: [0]) greaseString.
revision isNil
ifFalse:
[stream nextPut: $..
stream nextPutAll: revision greaseString].
stageLabel isNil
ifFalse:
[stream nextPutAll: stageLabel greaseString.
stageNumber isNil ifFalse: [stream nextPutAll: stageNumber greaseString]]]
]
isAlpha [
<category: 'testing'>
^stageLabel = #alpha
]
isBeta [
<category: 'testing'>
^stageLabel = #beta
]
isFinal [
<category: 'testing'>
^stageLabel isNil
]
major [
<category: 'accessing'>
^major
]
major: anInteger [
<category: 'accessing'>
major := anInteger
]
minor [
<category: 'accessing'>
^minor
]
minor: anInteger [
<category: 'accessing'>
minor := anInteger
]
revision [
<category: 'accessing'>
^revision
]
revision: anInteger [
<category: 'accessing'>
revision := anInteger
]
stage [
<category: 'accessing'>
^stageLabel
]
stage: aSymbol number: anInteger [
<category: 'accessing'>
stageLabel := aSymbol.
stageNumber := anInteger
]
stageNumber [
<category: 'accessing'>
^stageNumber
]
]

107
grease/Core/Text/GRCodec.st Normal file
View File

@ -0,0 +1,107 @@
GRObject subclass: GRCodec [
<comment: 'A codec defines how Seaside communicates without the outside world and how outside data is converted into the image (decoding) and back outside the image (encoding). The codec is essentially a stream factory that provides wrappers around standard streams. All streams do support binary mode for non-converted transfer.'>
<category: 'Grease-Core-Text'>
GRCodec class >> allCodecs [
"Answer all codecs supported in this system. This is a collection of codec instances."
<category: 'accessing'>
^self subclasses inject: self codecs asArray
into: [:result :each | result , each allCodecs]
]
GRCodec class >> codecs [
"Answer a collection of possible codecs of the receiver. To be overridden by concrete subclasses."
<category: 'accessing'>
^#()
]
GRCodec class >> forEncoding: aString [
"Answer a new codec instance for the given encoding name. Raise an WAUnsupportedEncodingError if the encoding name is not supported by this image."
<category: 'instance creation'>
self allSubclassesDo: [:each |
(each supportsEncoding: aString) ifTrue: [
^each basicForEncoding: aString]].
self unsupportedEncoding: aString
]
GRCodec class >> supportsEncoding: aString [
"Answer whether the the given encoding name is supported by this codec class."
<category: 'testing'>
self subclassResponsibility
]
GRCodec class >> basicForEncoding: aString [
"Create the actual instance."
<category: 'private'>
self subclassResponsibility
]
GRCodec class >> unsupportedEncoding: aString [
"Signal an unsupported encoding."
<category: 'private'>
GRUnsupportedEncodingError signal: 'unsupported encoding: ' , aString
]
name [
"Answer a human readable string of the receivers encoding policy."
<category: 'accessing'>
self subclassResponsibility
]
url [
"Answer a codec that is responsible to encode and decode URLs. In most cases an UTF-8 codec is the only valid choice, but subclasses might decide to do something else."
<category: 'accessing'>
self subclassResponsibility
]
decode: aString [
<category: 'convenience'>
| readStream writeStream |
readStream := self decoderFor: aString readStream.
writeStream := WriteStream on: (String new: aString size).
[readStream atEnd]
whileFalse: [writeStream nextPutAll: (readStream next: 1024)].
^writeStream contents
]
encode: aString [
<category: 'convenience'>
| writeStream |
writeStream := self encoderFor:
(WriteStream on: (String new: aString size)).
writeStream nextPutAll: aString.
^writeStream contents
]
decoderFor: aReadStream [
"Wrap aReadStream with an decoder for the codec of the receiver. Answer a read stream that delegates to and shares the state of aReadStream."
<category: 'conversion'>
self subclassResponsibility
]
encoderFor: aWriteStream [
"Wrap aWriteStream with an encoder for the codec of the receiver. Answer a write stream that delegates to and shares the state of aWriteStream."
<category: 'conversion'>
self subclassResponsibility
]
printOn: aStream [
<category: 'printing'>
super printOn: aStream.
aStream
nextPutAll: ' name: ';
print: self name
]
]

91
grease/Core/Text/GRCodecStream.st Normal file
View File

@ -0,0 +1,91 @@
GRObject subclass: GRCodecStream [
| stream |
<comment: 'A WACodecStream is a wrapper around a write stream and defines common behavior.
Instance Variables
stream: <WriteStream>
stream - a WriteStream
'>
<category: 'Grease-Core-Text'>
GRCodecStream class >> on: aStream [
<category: 'instance creation'>
^self basicNew initalizeOn: aStream
]
initalizeOn: aStream [
<category: 'initialization'>
self initialize.
stream := aStream
]
binary [
<category: 'accessing'>
]
contents [
<category: 'accessing'>
^stream contents
]
flush [
<category: 'accessing'>
stream flush
]
size [
<category: 'accessing'>
^stream size
]
text [
<category: 'accessing'>
]
crlf [
<category: 'streaming'>
self
nextPut: Character cr;
nextPut: Character lf
]
next [
<category: 'streaming'>
self subclassResponsibility
]
next: anInteger [
<category: 'streaming'>
self subclassResponsibility
]
nextPut: aCharacter [
<category: 'streaming'>
self subclassResponsibility
]
nextPutAll: aString [
<category: 'streaming'>
self subclassResponsibility
]
space [
<category: 'streaming'>
self nextPut: Character space
]
tab [
<category: 'streaming'>
self nextPut: Character tab
]
atEnd [
<category: 'testing'>
^stream atEnd
]
]

33
grease/Core/Text/GRInflector.st Normal file
View File

@ -0,0 +1,33 @@
GRObject subclass: GRInflector [
<comment: 'The Inflector transforms words from singular to plural.'>
<category: 'Grease-Core-Text'>
InflectionRules := nil.
Uninflected := nil.
GRInflector class >> pluralize: aString [
<category: 'accessing'>
| string |
string := aString asLowercase.
Uninflected do: [:each | (string endsWith: each) ifTrue: [^aString]].
InflectionRules do:
[:rule |
(string endsWith: rule first)
ifTrue: [^(aString allButLast: rule third) , rule second]].
^aString , 's'
]
GRInflector class >> initialize [
<category: 'initialization'>
Uninflected := #('bison' 'bream' 'breeches' 'britches' 'carp' 'chassis' 'clippers' 'cod' 'contretemps' 'corps' 'debris' 'deer' 'diabetes' 'djinn' 'eland' 'elk' 'equipment' 'fish' 'flounder' 'gallows' 'graffiti' 'headquarters' 'herpes' 'high-jinks' 'homework' 'information' 'innings' 'ities' 'itis' 'jackanapes' 'mackerel' 'measles' 'mews' 'money' 'mumps' 'news' 'ois' 'pincers' 'pliers' 'pox' 'proceedings' 'rabies' 'rice' 'salmon' 'scissors' 'sea-bass' 'series' 'shears' 'sheep' 'species' 'swine' 'trout' 'tuna' 'whiting' 'wildebeest').
InflectionRules := #(#('man' 'en' 2) #('child' 'ren' 0) #('cow' 'kine' 3) #('penis' 'es' 0) #('sex' 'es' 0) #('person' 'ople' 4) #('octopus' 'es' 0) #('quiz' 'zes' 0) #('ox' 'en' 0) #('louse' 'ice' 4) #('mouse' 'ice' 4) #('matrix' 'ices' 2) #('vertix' 'ices' 2) #('vertex' 'ices' 2) #('indix' 'ices' 2) #('index' 'ices' 2) #('x' 'es' 0) #('ch' 'es' 0) #('ss' 'es' 0) #('sh' 'es' 0) #('ay' 's' 0) #('ey' 's' 0) #('iy' 's' 0) #('oy' 's' 0) #('uy' 's' 0) #('y' 'ies' 1) #('alf' 'ves' 1) #('elf' 'ves' 1) #('olf' 'ves' 1) #('arf' 'ves' 1) #('nife' 'ves' 2) #('life' 'ves' 2) #('wife' 'ves' 2) #('sis' 'es' 2) #('tum' 'a' 2) #('ium' 'a' 2) #('buffalo' 'es' 0) #('tomato' 'es' 0) #('buffalo' 'es' 0) #('bus' 'es' 0) #('alias' 'es' 0) #('status' 'es' 0) #('octopus' 'i' 2) #('virus' 'i' 2) #('axis' 'es' 2) #('s' '' 0))
]
]
Eval [
GRInflector initialize
]

1
grease/Core/Text/GRInvalidUtf8Error.st Normal file
View File

@ -0,0 +1 @@
GRError subclass: GRInvalidUtf8Error []

36
grease/Core/Text/GRMappedPrinter.st Normal file
View File

@ -0,0 +1,36 @@
GRPrinter subclass: GRMappedPrinter [
| next block |
<comment: nil>
<category: 'Grease-Core-Text'>
GRMappedPrinter class >> block: aBlock next: aPrinter [
<category: 'instance creation'>
^(self new)
block: aBlock;
next: aPrinter;
yourself
]
block: aBlock [
<category: 'accessing'>
block := aBlock
]
next: aPrinter [
<category: 'accessing'>
next := aPrinter
]
initialize [
<category: 'initialization'>
super initialize.
self block: [:value | value]
]
print: anObject on: aStream [
<category: 'printing'>
next print: (block value: anObject) on: aStream
]
]

61
grease/Core/Text/GRNullCodec.st Normal file
View File

@ -0,0 +1,61 @@
GRCodec subclass: GRNullCodec [
<comment: 'The null codec always returns the original streams. It assumes that the outside world uses the same encoding as the inside world. This is highly efficient as no transformation is applied to the data, but has its drawbacks.'>
<category: 'Grease-Core-Text'>
GRNullCodec class >> codecs [
<category: 'accessing'>
^Array with: self new
]
GRNullCodec class >> supportsEncoding: aString [
<category: 'testing'>
^aString isNil
]
GRNullCodec class >> basicForEncoding: aString [
<category: 'private'>
^self new
]
name [
<category: 'accessing'>
^'(none)'
]
url [
"The selfish method. Let's do it with ourselves."
<category: 'accessing'>
^self
]
decode: aString [
"Overridden for efficencey."
<category: 'convenience'>
^aString
]
encode: aString [
"Overridden for efficencey."
<category: 'convenience'>
^aString
]
decoderFor: aReadStream [
"wrap to avoid String vs ByteArray issues"
<category: 'conversion'>
^GRNullCodecStream on: aReadStream
]
encoderFor: aWriteStream [
"wrap to avoid String vs ByteArray issues"
<category: 'conversion'>
^GRNullCodecStream on: aWriteStream
]
]

37
grease/Core/Text/GRNullCodecStream.st Normal file
View File

@ -0,0 +1,37 @@
GRCodecStream subclass: GRNullCodecStream [
<comment: 'A WANullCodecStream is a WriteStream on a String on which you can both put binary and character data without encoding happening.
Instance Variables
stream: <WriteStream>
stream
- a WriteStream on a String'>
<category: 'Grease-Core-Text'>
next [
<category: 'streaming'>
^stream next
]
next: anInteger [
<category: 'streaming'>
^stream next: anInteger
]
nextPut: aCharacterOrByte [
<category: 'streaming'>
aCharacterOrByte isCharacter
ifTrue: [stream nextPut: aCharacterOrByte]
ifFalse: [stream nextPut: (Character value: aCharacterOrByte)]
]
nextPutAll: aStringOrByteArray [
<category: 'streaming'>
aStringOrByteArray isString
ifTrue: [stream nextPutAll: aStringOrByteArray]
ifFalse: [1
to: aStringOrByteArray size
do: [:index | stream nextPut: (Character value: (aStringOrByteArray at: index))]]
]
]

228
grease/Core/Text/GRNumberPrinter.st Normal file
View File

@ -0,0 +1,228 @@
GRPrinter subclass: GRNumberPrinter [
| characters base delimiter digits infinite nan padding accuracy precision separator |
<comment: 'A GRNumberPrinter is prints numbers (integers and floats) in various formats in a platform independent way.
Instance Variables
accuracy: <UndefinedObject|Float>
base: <Integer>
delimiter: <UndefinedObject|Charater>
digits: <UndefinedObject|Integer>
infinite: <UndefinedObject|String>
nan: <UndefinedObject|String>
padding: <UndefinedObject|Charater>
precision: <Integer>
separator: <UndefinedObject|Charater>'>
<category: 'Grease-Core-Text'>
NumbersToCharactersLowercase := nil.
NumbersToCharactersUppercase := nil.
GRNumberPrinter class >> initialize [
<category: 'initialization'>
NumbersToCharactersLowercase := '0123456789abcdefghijklmnopqrstuvwxyz'.
NumbersToCharactersUppercase := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
]
accuracy: aFloat [
"Round towards the nearest number that is a multiple of aFloat."
<category: 'accessing'>
accuracy := aFloat
]
base: anInteger [
"The numeric base to which the number should be printed."
<category: 'accessing'>
base := anInteger
]
characters: aString [
"The characters to be used to convert a number to a string."
<category: 'accessing'>
characters := aString
]
delimiter: aCharacter [
"The delimiter to separate the integer and fraction part of the number."
<category: 'accessing'>
delimiter := aCharacter
]
digits: anInteger [
"The number of digits to be printed in the integer part."
<category: 'accessing'>
digits := anInteger
]
infinite: aString [
"The string that should be displayed if the number is positive or negative infinity."
<category: 'accessing'>
infinite := aString
]
nan: aString [
"The string that should be displayed if the number is not a number."
<category: 'accessing'>
nan := aString
]
padding: aCharacter [
"The padding for the integer part."
<category: 'accessing'>
padding := aCharacter
]
precision: anInteger [
"The number of digits to be printed in the fraction part."
<category: 'accessing'>
precision := anInteger
]
separator: aCharacter [
"Separator character to be used to group digits."
<category: 'accessing'>
separator := aCharacter
]
lowercase [
"Use lowercase characters for numbers of base 10 and higher."
<category: 'actions'>
self characters: NumbersToCharactersLowercase
]
uppercase [
"Use uppercase characters for numbers of base 10 and higher."
<category: 'actions'>
self characters: NumbersToCharactersUppercase
]
initialize [
<category: 'initialization'>
super initialize.
self lowercase.
self base: 10.
self delimiter: $..
self infinite: 'Infinite'.
self nan: 'NaN'.
self padding: $ .
self precision: 0
]
print: aNumber on: aStream [
<category: 'printing'>
aNumber isNaN ifTrue: [^self printNaN: aNumber on: aStream].
aNumber isInfinite ifTrue: [^self printInfinite: aNumber on: aStream].
precision = 0
ifTrue: [self printInteger: aNumber on: aStream]
ifFalse: [self printFloat: aNumber on: aStream]
]
printFloat: aNumber on: aStream [
<category: 'printing'>
| multiplier rounded |
multiplier := base asFloat raisedTo: precision.
rounded := aNumber roundTo: (accuracy ifNil: [1.0 / multiplier]).
self printInteger: rounded on: aStream.
delimiter isNil ifFalse: [aStream nextPut: delimiter].
self printFraction: rounded fractionPart abs * multiplier on: aStream
]
printFraction: aNumber on: aStream [
<category: 'printing'>
| result |
result := self
pad: (self digitsOf: aNumber rounded base: base)
left: $0
to: precision.
separator isNil ifFalse: [result := self separate: result left: separator].
aStream nextPutAll: result
]
printInfinite: aNumber on: aStream [
<category: 'printing'>
infinite isNil ifFalse: [aStream nextPutAll: infinite]
]
printInteger: aNumber on: aStream [
<category: 'printing'>
| result |
result := self digitsOf: aNumber integerPart base: base.
separator isNil
ifFalse: [result := self separate: result right: separator].
(digits isNil or: [padding isNil])
ifFalse: [result := self
pad: result
left: padding
to: digits].
aStream nextPutAll: result
]
printNaN: anInteger on: aStream [
<category: 'printing'>
nan isNil ifFalse: [aStream nextPutAll: nan]
]
digitsOf: aNumber base: aBaseInteger [
"Answer the absolute digits of aNumber in the base aBaseInteger."
<category: 'utilities'>
| integer stream next |
integer := aNumber truncated abs.
integer = 0 ifTrue: [^'0'].
stream := WriteStream on: (String new: 10).
[integer > 0] whileTrue:
[next := integer quo: aBaseInteger.
stream nextPut: (characters at: 1 + integer - (next * aBaseInteger)).
integer := next].
^stream contents reversed
]
separate: aString left: aCharacter [
"Separate from the left side every 3 characters with aCharacter."
<category: 'utilities'>
| size stream |
size := aString size.
stream := WriteStream on: (String new: 2 * size).
1
to: size
do: [:index |
(index ~= 1 and: [index \\ 3 = 1]) ifTrue: [stream nextPut: aCharacter].
stream nextPut: (aString at: index)].
^stream contents
]
separate: aString right: aCharacter [
"Separate from the right side every 3 characters with aCharacter."
<category: 'utilities'>
| size stream |
size := aString size.
stream := WriteStream on: (String new: 2 * size).
1
to: size
do: [:index |
(index ~= 1 and: [(size - index) \\ 3 = 2])
ifTrue: [stream nextPut: aCharacter].
stream nextPut: (aString at: index)].
^stream contents
]
]
Eval [
GRNumberPrinter initialize
]

24
grease/Core/Text/GROrdinalizePrinter.st Normal file
View File

@ -0,0 +1,24 @@
Eval [
'From PharoCore1.0rc1 of 19 October 2009 [Latest update: #10505] on 9 March 2010 at 6:38:04 pm'
]
GRPrinter subclass: GROrdinalizePrinter [
<comment: nil>
<category: 'Grease-Core-Text'>
print: anObject on: aStream [
<category: 'printing'>
aStream nextPutAll: (self ordinalize: anObject integerPart)
]
ordinalize: anInteger [
<category: 'private'>
^(anInteger \\ 100 between: 11 and: 13)
ifTrue: ['th']
ifFalse: [#('st' 'nd' 'rd') at: anInteger \\ 10 ifAbsent: ['th']]
]
]

28
grease/Core/Text/GRPluggablePrinter.st Normal file
View File

@ -0,0 +1,28 @@
GRPrinter subclass: GRPluggablePrinter [
| block |
<comment: nil>
<category: 'Grease-Core-Text'>
GRPluggablePrinter class >> on: aBlock [
<category: 'instance creation'>
^self new block: aBlock
]
block: aBlock [
<category: 'accessing'>
block := aBlock
]
initialize [
<category: 'initialization'>
super initialize.
self block: [:value | String new]
]
print: anObject on: aStream [
<category: 'printing'>
aStream nextPutAll: (block value: anObject)
]
]

328
grease/Core/Text/GRPrinter.st Normal file
View File

@ -0,0 +1,328 @@
GRObject subclass: GRPrinter [
<comment: nil>
<category: 'Grease-Core-Text'>
GRPrinter class >> cookieTimestamp [
"Netscape's original proposal defined an Expires header that took a date value in a fixed-length variant format in place of Max-Age: Wdy, DD-Mon-YY HH:MM:SS GMT"
<category: 'factory'>
^GRMappedPrinter block: [:timestamp | timestamp asUTC]
next: self abbreviatedWeekName , ', ' , self paddedDay , '-'
, self abbreviatedMonthName , '-'
, self paddedYear , ' '
, self isoTime , ' GMT'
]
GRPrinter class >> httpDate [
"Answers a printer that formats dates for HTTP1.1 (RFC 2616)"
<category: 'factory'>
^self rfc1123
]
GRPrinter class >> isoDate [
"Ansers a printer that formats dates accoring to ISO(YYYY-MM-DD) E.g.
2003-12-24"
<category: 'factory'>
^self paddedYear , $- , self paddedMonth , $- , self paddedDay
]
GRPrinter class >> isoTime [
"Ansers a printer that formats time accoring to ISO(HH:MM:SS) E.g.
12:23:34"
<category: 'factory'>
^self paddedHour24 , $: , self paddedMinute , $: , self paddedSecond
]
GRPrinter class >> rfc1123 [
"Answers a printer that formats dates for HTTP1.1 (RFC 1123). Eg.
Sun, 06 Nov 1994 08:49:37 GMT"
<category: 'factory'>
^GRMappedPrinter block:
[:date |
"For the purposes of HTTP, GMT is exactly equal to UTC (Coordinated Universal Time)"
date asUTC]
next: GRSequentialPrinter new , self abbreviatedWeekName , ', '
, self paddedDay , Character space
, self abbreviatedMonthName , Character space
, self paddedYear , Character space
, self isoTime , ' GMT'
]
GRPrinter class >> rfc822 [
"Answers a privter that formats dates according to RFC 822 (email). Eg.
Sun, 31 Aug 2008 19:41:46 +0200"
<category: 'factory'>
^self abbreviatedWeekName , ', ' , self paddedDay , Character space
, self abbreviatedMonthName , Character space
, self paddedYear , Character space
, self isoTime , Character space
, self offsetSign , self absOffsetHoursPadded
, self absOffsetMinutesPadded
]
GRPrinter class >> rfc822WithTimeZone: aString [
"Answers a privter that formats dates according to RFC 822 (email) with the given time zone String. Eg.
Sun, 31 Aug 2008 19:41:46 <aString>"
<category: 'factory'>
^self abbreviatedWeekName , ', ' , self paddedDay , Character space
, self abbreviatedMonthName , Character space
, self paddedYear , Character space
, self isoTime , Character space
, aString
]
GRPrinter class >> swissCurrency [
<category: 'factory'>
^GRSequentialPrinter new , 'CHF ' , GRSignPrinter new
, ((GRNumberPrinter new)
separator: $';
precision: 2;
accuracy: 0.05;
yourself)
]
GRPrinter class >> usCurrency [
<category: 'factory'>
^GRSignPrinter new , $$ , ((GRNumberPrinter new)
separator: $,;
precision: 2;
yourself)
]
GRPrinter class >> abbreviatedMonthName [
<category: 'parts-date'>
^self
monthName: #('Jan' 'Feb' 'Mar' 'Apr' 'May' 'Jun' 'Jul' 'Aug' 'Sep' 'Oct' 'Nov' 'Dec')
]
GRPrinter class >> abbreviatedWeekName [
<category: 'parts-date'>
^self weekName: #('Sun' 'Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat')
]
GRPrinter class >> absOffsetHoursPadded [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date offset hours abs]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> absOffsetMinutesPadded [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date offset minutes abs]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> fullMonthName [
<category: 'parts-date'>
^self
monthName: #('January' 'February' 'March' 'April' 'May' 'June' 'July' 'August' 'September' 'October' 'November' 'December')
]
GRPrinter class >> fullWeekName [
<category: 'parts-date'>
^self
weekName: #('Monday' 'Tuesday' 'Wednesday' 'Thursday' 'Friday' 'Saturday' 'Sunday')
]
GRPrinter class >> monthName: anArray [
<category: 'parts-date'>
^GRPluggablePrinter on: [:date | anArray at: date monthIndex]
]
GRPrinter class >> offsetSign [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date offset]
next: ((GRSignPrinter new)
positivePrinter: $+;
negativePrinter: $-;
yourself)
]
GRPrinter class >> paddedCentury [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date year \\ 100]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedDay [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date dayOfMonth]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedMonth [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date monthIndex]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedYear [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date year]
next: (self numberWithAtLeastDigits: 4)
]
GRPrinter class >> unpaddedCentury [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date year \\ 100]
next: GRNumberPrinter new
]
GRPrinter class >> unpaddedDay [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date dayOfMonth] next: GRNumberPrinter new
]
GRPrinter class >> unpaddedMonth [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date monthIndex] next: GRNumberPrinter new
]
GRPrinter class >> unpaddedYear [
<category: 'parts-date'>
^GRMappedPrinter block: [:date | date year] next: GRNumberPrinter new
]
GRPrinter class >> weekName: anArray [
<category: 'parts-date'>
^GRPluggablePrinter on: [:date | anArray at: date dayOfWeek]
]
GRPrinter class >> paddedHour12 [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedHour24 [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time hour]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedMinute [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time minute]
next: (self numberWithAtLeastDigits: 2)
]
GRPrinter class >> paddedSecond [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time second]
next: ((GRNumberPrinter new)
padding: $0;
digits: 2)
]
GRPrinter class >> unpaddedHour12 [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1]
next: GRNumberPrinter new
]
GRPrinter class >> unpaddedHour24 [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time hour] next: GRNumberPrinter new
]
GRPrinter class >> unpaddedMinute [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time minute] next: GRNumberPrinter new
]
GRPrinter class >> unpaddedSecond [
<category: 'parts-time'>
^GRMappedPrinter block: [:time | time second] next: GRNumberPrinter new
]
GRPrinter class >> binaryFileSize [
<category: 'parts-units'>
^GRUnitPrinter base: 1024
units: #('byte' 'bytes' 'KiB' 'MiB' 'GiB' 'TiB' 'PiB' 'EiB' 'ZiB' 'YiB')
]
GRPrinter class >> decimalFileSize [
<category: 'parts-units'>
^GRUnitPrinter base: 1000
units: #('byte' 'bytes' 'kB' 'MB' 'GB' 'TB' 'PB' 'EB' 'ZB' 'YB')
]
GRPrinter class >> numberWithAtLeastDigits: anInteger [
<category: 'parts-units'>
^(GRNumberPrinter new)
padding: $0;
digits: anInteger;
yourself
]
, aPrinter [
<category: 'operators'>
^GRSequentialPrinter new , self , aPrinter
]
print: anObject [
<category: 'printing'>
^String streamContents: [:stream | self print: anObject on: stream]
]
print: anObject on: aStream [
"Subclasses override this method to produce some output."
<category: 'printing'>
]
pad: aString center: aCharacter to: anInteger [
"Pad to the center of aString with aCharacter to at least anInteger characters."
<category: 'utilities'>
| result index |
anInteger <= aString size ifTrue: [^aString].
index := (anInteger - aString size) // 2.
result := (String new: anInteger) atAllPut: aCharacter.
result
replaceFrom: index + 1
to: index + aString size
with: aString
startingAt: 1.
^result
]
pad: aString left: aCharacter to: anInteger [
"Pad to the left side of aString with aCharacter to at least anInteger characters."
<category: 'utilities'>
| result |
anInteger <= aString size ifTrue: [^aString].
result := (String new: anInteger) atAllPut: aCharacter.
result
replaceFrom: anInteger - aString size + 1
to: anInteger
with: aString
startingAt: 1.
^result
]
pad: aString right: aCharacter to: anInteger [
"Pad to the right side of aString with aCharacter to at least anInteger characters."
<category: 'utilities'>
| result |
anInteger <= aString size ifTrue: [^aString].
result := (String new: anInteger) atAllPut: aCharacter.
result
replaceFrom: 1
to: aString size
with: aString
startingAt: 1.
^result
]
]

22
grease/Core/Text/GRSequentialPrinter.st Normal file
View File

@ -0,0 +1,22 @@
GRPrinter subclass: GRSequentialPrinter [
| parts |
<comment: nil>
<category: 'Grease-Core-Text'>
initialize [
<category: 'initialization'>
super initialize.
parts := OrderedCollection new
]
, aConverter [
<category: 'operators'>
parts add: aConverter
]
print: anObject on: aStream [
<category: 'printing'>
parts do: [:each | each print: anObject on: aStream]
]
]

35
grease/Core/Text/GRSignPrinter.st Normal file
View File

@ -0,0 +1,35 @@
GRPrinter subclass: GRSignPrinter [
| negativePrinter positivePrinter |
<comment: nil>
<category: 'Grease-Core-Text'>
negativePrinter: aPrinter [
"The printer to be used when the number is negative."
<category: 'accessing'>
negativePrinter := aPrinter
]
positivePrinter: aPrinter [
"The printer to be used when the number is zero or positive."
<category: 'accessing'>
positivePrinter := aPrinter
]
initialize [
<category: 'initialization'>
super initialize.
self negativePrinter: $-.
self positivePrinter: nil
]
print: anObject on: aStream [
<category: 'printing'>
anObject negative
ifTrue: [negativePrinter print: anObject on: aStream]
ifFalse: [positivePrinter print: anObject on: aStream]
]
]

106
grease/Core/Text/GRStringPrinter.st Normal file
View File

@ -0,0 +1,106 @@
GRPrinter subclass: GRStringPrinter [
| trim length pad character |
<comment: nil>
<category: 'Grease-Core-Text'>
character: aCharacter [
"The character to pad the string with."
<category: 'accessing'>
character := aCharacter
]
length: anInteger [
"The maximal size of the string, or the size to pad to."
<category: 'accessing'>
length := anInteger
]
initialize [
<category: 'initialization'>
super initialize.
self
character: $ ;
length: nil.
self
trimNone;
padNone
]
padCenter [
"Pad to the center."
<category: 'padding'>
pad := #pad:center:to:
]
padLeft [
"Pad to the left."
<category: 'padding'>
pad := #pad:left:to:
]
padNone [
"Do not pad the input."
<category: 'padding'>
pad := nil
]
padRight [
"Pad to the right."
<category: 'padding'>
pad := #pad:right:to:
]
print: anObject on: aStream [
<category: 'printing'>
| string |
string := anObject greaseString.
trim isNil ifFalse: [string := string perform: trim].
length isNil
ifFalse: [
length < string size ifTrue: [string := string copyFrom: 1 to: length].
(pad isNil or: [character isNil])
ifFalse: [
string := self
perform: pad
with: string
with: character
with: length]].
aStream nextPutAll: string
]
trimBoth [
"Trim to the left and to the right."
<category: 'trimming'>
trim := #trimBoth
]
trimLeft [
"Trim to the left and to the right."
<category: 'trimming'>
trim := #trimLeft
]
trimNone [
"Do not trim the input."
<category: 'trimming'>
trim := nil
]
trimRight [
"Trim to the left and to the right."
<category: 'trimming'>
trim := #trimRight
]
]

82
grease/Core/Text/GRUnitPrinter.st Normal file
View File

@ -0,0 +1,82 @@
Eval [
'From PharoCore1.0rc1 of 19 October 2009 [Latest update: #10505] on 9 March 2010 at 6:45:25 pm'
]
GRPrinter subclass: GRUnitPrinter [
| integerPrinter fractionPrinter units base |
<comment: nil>
<category: 'Grease-Core-Text'>
GRUnitPrinter class >> base: anInteger units: anArray [
<category: 'instance creation'>
^(self new)
base: anInteger;
units: anArray;
yourself
]
base: anInteger [
<category: 'accessing'>
base := anInteger
]
fractionPrinter: aPrinter [
<category: 'accessing'>
fractionPrinter := aPrinter
]
integerPrinter: aPrinter [
<category: 'accessing'>
integerPrinter := aPrinter
]
units: anArray [
<category: 'accessing'>
units := anArray
]
initialize [
<category: 'initialization'>
super initialize.
self integerPrinter: ((GRNumberPrinter new)
precision: 0;
yourself).
self fractionPrinter: ((GRNumberPrinter new)
precision: 1;
yourself)
]
print: anObject on: aStream [
<category: 'printing'>
anObject = 1
ifTrue:
[^self
print: anObject
unit: units first
on: aStream].
units allButFirst inject: anObject asFloat
into:
[:value :each |
value < base
ifFalse: [value / base]
ifTrue:
[^self
print: value
unit: each
on: aStream]]
]
print: aNumber unit: aString on: aStream [
<category: 'printing'>
(units first = aString or: [units second = aString])
ifTrue: [integerPrinter print: aNumber on: aStream]
ifFalse: [fractionPrinter print: aNumber on: aStream].
aStream
nextPut: $ ;
nextPutAll: aString
]
]

6
grease/Core/Text/GRUnsupportedEncodingError.st Normal file
View File

@ -0,0 +1,6 @@
GRError subclass: GRUnsupportedEncodingError [
<comment: nil>
<category: 'Grease-Core-Text'>
]

48
grease/Core/Utilities/GRBoundDelayedSend.st Normal file
View File

@ -0,0 +1,48 @@
GRDelayedSend subclass: GRBoundDelayedSend [
| arguments |
<comment: 'A delayed send that has some or all of the arguments defined in advance. Additionally supplied arguments will be added, if possible, to these when the object is evaluate.
Instance Variables
arguments: <Array>
arguments
- the predefined arguments'>
<category: 'Grease-Core-Utilities'>
argumentCount [
<category: 'accessing'>
^selector numArgs - arguments size
]
valueWithArguments: anArray [
<category: 'evaluating'>
^arguments size + anArray size = selector numArgs
ifTrue: [receiver perform: selector withArguments: arguments , anArray]
ifFalse: [self invalidArgumentCount]
]
valueWithPossibleArguments: anArray [
<category: 'evaluating'>
| composed |
^(composed := arguments , anArray) size < selector numArgs
ifTrue: [self invalidArgumentCount]
ifFalse:
[receiver perform: selector
withArguments: (composed first: selector numArgs)]
]
initializeWithReceiver: anObject selector: aSymbol arguments: anArray [
<category: 'initialization'>
self initializeWithReceiver: anObject selector: aSymbol.
arguments := anArray asArray
]
printOn: aStream [
<category: 'printing'>
super printOn: aStream.
aStream
nextPutAll: ' arguments: ';
print: arguments
]
]

104
grease/Core/Utilities/GRDelayedSend.st Normal file
View File

@ -0,0 +1,104 @@
GRObject subclass: GRDelayedSend [
| receiver selector |
<comment: 'A WADelayedSend is a future message send of a message to an object. Some of the arguments can be predefined. Instances are intended to be interchangeable with blocks.
This class should conform the ANSI valuable protocol.
This is an abstract class. Use the methods in the ''instance-creation'' protocol on the class side to create intances.
Instance Variables
receiver: <Object>
selector: <Symbol>
receiver
- the object receiving the message
selector
- the message selector sent to the receiver'>
<category: 'Grease-Core-Utilities'>
GRDelayedSend class >> receiver: anObject selector: aSymbol [
<category: 'instance creation'>
^GRUnboundDelayedSend basicNew initializeWithReceiver: anObject
selector: aSymbol
]
GRDelayedSend class >> receiver: anObject selector: aSymbol argument: aParameter [
<category: 'instance creation'>
^self
receiver: anObject
selector: aSymbol
arguments: (Array with: aParameter)
]
GRDelayedSend class >> receiver: anObject selector: aSymbol arguments: anArray [
<category: 'instance creation'>
^GRBoundDelayedSend basicNew
initializeWithReceiver: anObject
selector: aSymbol
arguments: anArray
]
argumentCount [
"Answer the number of arguments that must be provided to the receiver when sending it."
<category: 'accessing'>
self subclassResponsibility
]
fixCallbackTemps [
"For polymorphism with BlockContext>>#fixCallbackTemps."
<category: 'accessing'>
]
value [
<category: 'evaluating'>
^self valueWithArguments: #()
]
value: anObject [
<category: 'evaluating'>
^self valueWithArguments: (Array with: anObject)
]
value: aFirstObject value: aSecondObject [
<category: 'evaluating'>
^self valueWithArguments: (Array with: aFirstObject with: aSecondObject)
]
valueWithArguments: anArray [
<category: 'evaluating'>
self subclassResponsibility
]
valueWithPossibleArguments: anArray [
<category: 'evaluating'>
self subclassResponsibility
]
initializeWithReceiver: anObject selector: aSymbol [
<category: 'initialization'>
self initialize.
receiver := anObject.
selector := aSymbol
]
printOn: aStream [
<category: 'printing'>
super printOn: aStream.
aStream
nextPutAll: ' receiver: ';
print: receiver.
aStream
nextPutAll: ' selector: ';
print: selector
]
invalidArgumentCount [
<category: 'private'>
GRInvalidArgumentCount signal
]
]

6
grease/Core/Utilities/GRInvalidArgumentCount.st Normal file
View File

@ -0,0 +1,6 @@
GRError subclass: GRInvalidArgumentCount [
<comment: 'Signaled whenever a message is sent with the incorrect number of arguments.'>
<category: 'Grease-Core-Utilities'>
]

25
grease/Core/Utilities/GRUnboundDelayedSend.st Normal file
View File

@ -0,0 +1,25 @@
GRDelayedSend subclass: GRUnboundDelayedSend [
<comment: 'A delayed send that has none of the arguments defined in advance.'>
<category: 'Grease-Core-Utilities'>
argumentCount [
<category: 'accessing'>
^selector numArgs
]
valueWithArguments: anArray [
<category: 'evaluating'>
^anArray size = selector numArgs
ifTrue: [receiver perform: selector withArguments: anArray]
ifFalse: [self invalidArgumentCount]
]
valueWithPossibleArguments: anArray [
<category: 'evaluating'>
^anArray size < selector numArgs
ifTrue: [self invalidArgumentCount]
ifFalse: [self valueWithArguments: (anArray first: selector numArgs)]
]
]

394
grease/GST/Core/Extensions.st Normal file
View File

@ -0,0 +1,394 @@
GRPackage class extend [
greaseGSTCore [
<category: '*Grease-GST-Core'>
^(self new)
name: 'Grease-GST-Core';
addDependency: 'Grease-Core';
url: #gstUrl;
yourself
]
greaseTestsGSTCore [
<category: '*Grease-Tests-GST-Core'>
^(self new)
name: 'Grease-Tests-GST-Core';
description: 'Unit tests for the package Grease-GST-Core.';
addDependency: 'Grease-GST-Core';
addDependency: 'Grease-Tests-Core';
url: #gstUrl;
yourself
]
]
GRPackage extend [
gstUrl [
<category: '*Grease-GST-Core'>
^'http://git.savannah.gnu.org/r/smalltalk.git/'
]
]
Object extend [
isEmptyOrNil [
<category: '*Grease-GST-Core'>
^false
]
]
Collection extend [
isEmptyOrNil [
<category: '*Grease-GST-Core'>
^self isEmpty
]
]
Interval extend [
]
UndefinedObject extend [
isEmptyOrNil [
<category: '*Grease-GST-Core'>
^true
]
]
BlockClosure extend [
fixCallbackTemps [
<category: '*Grease-GST-Core'>
]
]
Behavior extend [
fullName [
<category: '*Grease-GST-Core'>
^self nameIn: Smalltalk
]
startUp: aBoolean [
"StartUo/ShutDown. See GRGSTPlatform class methods about startUpList and shutDownList"
<category: '*Grease-GST-Core'>
]
shutDown: aBoolean [
"StartUo/ShutDown. See GRGSTPlatform class methods about startUpList and shutDownList"
<category: '*Grease-GST-Core'>
]
]
Time class extend [
totalSeconds [
<category: '*Grease-GST-Core'>
^self secondClock
]
]
Date class extend [
year: y month: m day: d [
<category: '*Grease-GST-Core'>
^self new setDay: d monthIndex: m year: y
]
]
PositionableStream extend [
greaseUpToAll: aCollection [
"Needed for Seaside ports to other dialects where #upToAll: may have
different semantics"
^ self upToAll: aCollection
]
]
WriteStream extend [
crlf [
<category: '*Grease-GST-Core'>
self
nextPut: Character cr;
nextPut: Character lf
]
]
Random extend [
nextInt: anInteger [
<category: '*Grease-GST-Core'>
anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ].
^(self next * anInteger) truncated + 1
]
]
DirectedMessage extend [
valueWithPossibleArguments: anArray [
<category: '*Grease-GST-Core'>
| arguments |
arguments := Array new: self selector numArgs.
arguments replaceFrom: 1
to: (args size min: arguments size)
with: args
startingAt: 1.
arguments size > args size ifTrue: [
arguments replaceFrom: args size + 1
to: (args size + anArray size min: arguments size)
with: anArray
startingAt: 1].
^self valueWithArguments: arguments
]
]
BlockClosure extend [
argumentCount [
<category: '*Grease-GST-Core'>
^self numArgs
]
valueWithPossibleArguments: aCollection [
<category: '*Grease-GST-Core'>
| args |
(aCollection size == self numArgs)
ifTrue: [^self valueWithArguments: aCollection].
args := Array new: self numArgs.
args replaceFrom: 1
to: (aCollection size min: args size)
with: aCollection
startingAt: 1.
^self valueWithArguments: args
]
]
Symbol extend [
capitalized [
<category: '*Grease-GST-Core'>
^self asString capitalized asSymbol
]
isKeyword [
<category: '*Grease-GST-Core'>
^self last = $:
]
isUnary [
<category: '*Grease-GST-Core'>
^self isKeyword not and: [
self first isLetter]
]
asMutator [
<category: '*Grease-GST-Core'>
"Return a setter message from a getter message. For example,
#name asMutator returns #name:"
^ (self copyWith: $:) asSymbol
]
]
String extend [
reversed [
<category: '*Grease-GST-Core'>
^self reverse
]
beginsWith: aString [
<category: '*Grease-GST-Core'>
^self startsWith: aString
]
sort [
<category: '*Grease-GST-Core'>
self sort: [:a :b | a <= b]
]
sort: aBlock [
<category: '*Grease-GST-Core'>
self
replaceFrom: 1
to: self size
with: (self asSortedCollection: aBlock) asString
startingAt: 1
]
capitalized [
<category: '*Grease-GST-Core'>
| cap |
self isEmpty ifTrue: [^self].
cap := self copy.
cap at: 1 put: (self at: 1) asUppercase.
^cap
]
]
Character extend [
greaseInteger [
<category: '*Grease-GST-Core'>
^self codePoint
]
asUnicode [
<category: '*Grease-GST-Core'>
^self codePoint
]
]
CharacterArray extend [
greaseString [
<category: '*Greasease-GST-Core'>
^self asString
]
]
Number extend [
isFraction [
<category: '*Grease-GST-Core'>
^false
]
weeks [
<category: '*Grease-GST-Core'>
^Duration weeks: self
]
days [
<category: '*Grease-GST-Core'>
^Duration days: self
]
hours [
<category: '*Grease-GST-Core'>
^Duration hours: self
]
minutes [
<category: '*Grease-GST-Core'>
^Duration minutes: self
]
seconds [
<category: '*Grease-GST-Core'>
^Duration seconds: self
]
milliseconds [
<category: '*Grease-GST-Core'>
^Duration milliseconds: self
]
isZero [
<category: '*Grease-GST-Core'>
^self = 0
]
]
Float class extend [
nan [
<category: '*Grease-GST-Core'>
"Why a FloatD?"
^FloatD nan
]
infinity [
<category: '*Grease-GST-Core'>
"Why a FloatD?"
^FloatD infinity
]
]
Collection extend [
any [
<category: '*Grease-GST-Core'>
^self anyOne
]
sorted [
<category: '*Grease-GST-Core'>
^self asArray sort
]
sorted: aBlock [
<category: '*Grease-GST-Core'>
^self asArray sort: aBlock
]
isCollection [
<category: '*Grease-GST-Core'>
^true
]
]
Object extend [
printStringLimitedTo: anInteger [
"Answer a String representing the receiver, without making it longer
than anInteger characters"
<category: 'printing'>
| stream |
stream := WriteStream on: String new.
self printOn: stream.
^stream position > anInteger
ifTrue: [ (stream copyFrom: 0 to: anInteger - 4), '...' ]
ifFalse: [ stream contents ]
]
]
Duration extend [
milliseconds [
<category: '*Grease-GST-Core'>
^0
]
]
BlockClosure extend [
fixCallbackTemps [
<category: '*Grease-GST-Core'>
outerContext isNil ifTrue: [^self].
^self shallowCopy outerContext: outerContext fixCallbackTemps; yourself
]
]
BlockContext extend [
fixCallbackTemps [
<category: '*Grease-GST-Core'>
outerContext isNil ifTrue: [^self shallowCopy].
^self shallowCopy outerContext: outerContext fixCallbackTemps; yourself
]
]
ContextPart extend [
fixCallbackTemps [
<category: '*Grease-GST-Core'>
^self shallowCopy
]
]
DirectedMessage extend [
argumentCount [
"Answer the number of missing arguments to complete the number required
by the receiver's selector"
<category: '*Grease-GST-Core'>
^self selector numArgs - self arguments size
]
fixCallbackTemps [
<category: '*Grease-GST-Core'>
^self
]
]

86
grease/GST/Core/GRGSTGenericCodec.st Normal file
View File

@ -0,0 +1,86 @@
GRCodec subclass: GRGSTGenericCodec [
| encoding urlCodec |
<comment: nil>
<category: 'Grease-GST-Core'>
GRGSTGenericCodec class [
basicForEncoding: aString [
<category: 'private'>
(self supportsEncoding: aString)
ifFalse: [self unsupportedEncoding: aString].
^self basicNew initializeWithEncoding: aString
]
supportedEncodingNames [
"answers the names of the encodings supported by this class"
<category: 'private'>
^#('UTF-8')
]
codecs [
<category: 'accessing'>
^self supportedEncodingNames collect: [:each |
self basicForEncoding: each]
]
supportsEncoding: aString [
"Answer whether the the given encoding name is supported."
<category: 'testing'>
^true
"^self supportedEncodingNames includes: aString"
]
]
decoderFor: aStream [
<category: 'conversion'>
^(I18N.EncodedStream unicodeOn: aStream encoding: encoding)
]
encoderFor: aStream [
<category: 'conversion'>
aStream species == ByteArray
ifTrue: [ ^self encoderFor: aStream contents asString ].
^aStream species == UnicodeString
ifTrue: [ I18N.EncodedStream encoding: aStream to: encoding ]
ifFalse: [ I18N.EncodedStream on: aStream to: encoding ]
]
decode: aString [
<category: 'conversion'>
^(self decoderFor: aString readStream) contents
]
encode: aString [
<category: 'conversion'>
^(self encoderFor: aString readStream) contents asString
]
initializeWithEncoding: aString [
<category: 'initialization'>
self initialize.
encoding := aString.
urlCodec := self
]
name [
<category: 'accessing'>
^encoding
]
url [
"RFC 3986: When a new URI scheme defines a component that represents
textual data consisting of characters from the Universal Character Set
[UCS], the data should first be encoded as octets according to the UTF-8
character encoding."
<category: 'accessing'>
^urlCodec
]
]

326
grease/GST/Core/GRGSTPlatform.st Normal file
View File

@ -0,0 +1,326 @@
GRPlatform subclass: GRGSTPlatform [
<comment: 'A WASqueakPlatform is the Squeak implementation of
SeasidePlatformSupport, the Seaside class that provides functionality
that can not be implemented in a platform independent way.'>
<category: 'Grease-Gst-Core'>
GRGSTPlatform class [
| startUpList shutdownList |
initialize [
<category: 'class initialization'>
startUpList := OrderedCollection new.
shutdownList := OrderedCollection new.
self select
]
unload [
<category: 'class initialization'>
self unselect
]
update: anAspect [
<category: 'startup'>
anAspect == #returnFromSnapshot ifTrue: [
startUpList do: [:each | each startUp: true]].
anAspect == #aboutToQuit ifTrue: [
shutdownList do: [:each | each shutDown: true]]
]
addToStartUpList: anObject [
<category: 'startup'>
(startUpList includes: anObject) ifFalse: [
startUpList add: anObject]
]
addToShutDownList: anObject [
<category: 'startup'>
(shutdownList includes: anObject) ifFalse: [
shutdownList add: anObject]
]
removeFromStartUpList: anObject [
<category: 'startup'>
(startUpList includes: anObject) ifTrue: [
startUpList remove: anObject]
]
removeFromShutDownList: anObject [
<category: 'startup'>
(shutdownList includes: anObject) ifTrue: [
shutdownList remove: anObject]
]
]
newline [
"Answer the system's default newline character (sequence)."
<category: 'accessing'>
^'
'
]
addToShutDownList: anObject [
"Add anObject to the shutdown-list of the system. On shutdown the
message #shutDown will be sent to anObject."
<category: 'startup'>
self class addToShutDownList: anObject
]
addToStartUpList: anObject [
"Add anObject to the startup-list of the system. On startup the message
#startUp will be sent to anObject."
<category: 'startup'>
self class addToStartUpList: anObject
]
removeFromShutDownList: anObject [
"Remove anObject from the shutdown list in the system."
<category: 'startup'>
self class removeFromShutDownList: anObject
]
removeFromStartUpList: anObject [
"Remove anObject from the startup list in the system."
<category: 'startup'>
self class removeFromStartUpList: anObject
]
asMethodReturningByteArray: aByteArrayOrString named: aSymbol [
"Generates the source of a method named aSymbol that returns
aByteArrayOrString as a ByteArray"
<category: 'file library'>
^String streamContents: [ :stream |
stream nextPutAll: aSymbol; nextPutAll: ' [ '; nl.
stream tab; nextPutAll: ' ^#['.
aByteArrayOrString asByteArray
do: [ :each | each printOn: stream ]
separatedBy: [ stream space ].
stream nextPutAll: ']'; nl; nextPutAll: ']' ]
]
compile: aString into: aClass classified: aSymbol [
<category: 'file library'>
aClass compile: aString classified: aSymbol
]
contentsOfFile: aString binary: aBoolean [
<category: 'file library'>
| data |
data := (File name: aString) contents.
aBoolean ifTrue: [ data := data asByteArray ].
^data
]
convertToSmalltalkNewlines: aString [
"Convert any line endings (CR, CRLF, LF) to CR."
<category: 'file library'>
aString isNil ifTrue: [ ^ nil ].
^aString class streamContents: [ :writeStream |
| readStream |
readStream := aString readStream.
[ readStream atEnd ] whileFalse: [
| next |
next := readStream next.
next = Character cr
ifTrue: [
readStream peek = Character lf
ifTrue: [ readStream skip: 1 ].
writeStream nextPut: Character cr ]
ifFalse: [
next = Character lf
ifTrue: [ writeStream nextPut: Character cr ]
ifFalse: [ writeStream nextPut: next ] ] ] ]
]
ensureExistenceOfFolder: aString [
"creates a folder named aString in the image directory"
<category: 'file library'>
(Directory image / aString) create
]
filesIn: aPathString [
"Return a collection of absolute paths for all the files (no directories) in the directory given by aPathString
must not include file names that start with ."
<category: 'file library'>
| directory |
directory := File name: aPathString.
^(directory files
reject: [:each | each name first = $.])
collect: [:each | each asString]
]
localNameOf: aFilename [
<category: 'file library'>
^File stripPathFrom: aFilename
]
removeSelector: aSymbol from: aClass [
<category: 'file library'>
aClass removeSelector: aSymbol
]
write: aStringOrByteArray toFile: aFileNameString inFolder: aFolderString [
"writes aStringOrByteArray to a file named aFilenameString in the folder aFolderString"
<category: 'file library'>
| stream fileName |
aFolderString / aFileNameString withWriteStreamDo: [ :stream |
stream nextPutAll: aStringOrByteArray ]
]
base64Decode: aString [
<category: 'encoding'>
| codeChars decoder output index nl endChars end limit padding data sz |
codeChars := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'.
decoder := (0 to: 255)
collect: [:n | (codeChars indexOf: (n + 1) asCharacter) - 1].
decoder replaceAll: -1 with: 0.
output := (data := String new: aString size * 3 // 4)
writeStream.
index := 1.
nl := Character nl.
"There is padding at the end of a base64 message if the content is not a multiple of
3 bytes in length. The padding is either two ='s to pad-out a trailing byte, 1 = to
pad out a trailing pair of bytes, or no padding. Here we count the padding. After
processing the message we cut-back by the amount of padding."
sz := end := aString size.
endChars := codeChars , (String with: $=).
[(endChars includes: (aString at: end))
and: [end = sz or: [(aString at: end + 1) = nl]]]
whileFalse: [end := end - 1].
limit := end.
padding := 0.
[(aString at: end) == $=] whileTrue:
[padding := padding - 1.
end := end - 1].
[index <= limit] whileTrue:
[| triple |
triple := ((decoder at: (aString at: index) asInteger) bitShift: 18)
+ ((decoder at: (aString at: index + 1) asInteger) bitShift: 12)
+ ((decoder at: (aString at: index + 2) asInteger) bitShift: 6)
+ (decoder at: (aString at: index + 3) asInteger).
output nextPut: (Character value: (triple digitAt: 3)).
output nextPut: (Character value: (triple digitAt: 2)).
output nextPut: (Character value: (triple digitAt: 1)).
index := index + 4.
[(index > sz or: [(aString at: index) = nl]) and: [index <= limit]]
whileTrue: [index := index + 1]].
padding ~= 0 ifTrue: [output skip: padding].
^data copyFrom: 1 to: output position
]
isProcessTerminated: aProcess [
"Return a boolean indicating whether aProcess has been terminated."
<category: 'processes'>
^aProcess isTerminated
]
terminateProcess: aProcess [
"Permanently terminate the process, unwinding first to execute #ensure:
and #ifCurtailed: blocks."
<category: 'processes'>
aProcess terminate
]
label [
<category: 'version info'>
^'GNU Smalltalk'
]
newRandom [
"Answers the random number generator to be used to create session and
continuation keys. Make sure it is seeded. They only methods that will
be sent to it are:
#nextInt: - should answer a random integer in the interval [1, anInteger]
#randomFrom: - should answer a random element from the given collection
Make sure that both methods are safe under heavy concurrent load.
Used by Gemstone/S traditional Randoms which cannot be persisted.
Used by Squeak to use a secure random when avaiable."
<category: 'factory'>
^GRGSTRandomProvider
]
readWriteByteStream [
"ByteArray based read write stream"
<category: 'factory'>
^ReadWriteStream on: ByteArray new
]
readWriteCharacterStream [
"String based read write stream"
<category: 'factory'>
^ReadWriteStream on: ''
]
semaphoreClass [
"used by Gemstone/S traditional Semaphores which cannot be persisted"
<category: 'factory'>
^Semaphore
]
weakDictionaryOfSize: aNumber [
<category: 'factory'>
^WeakKeyIdentityDictionary new: aNumber
]
openDebuggerOn: anError [
<category: 'exceptions'>
| process |
process := Processor activeProcess.
"If we are running in the UI process, we don't want to suspend the active process. The
error was presumably triggered while stepping in the Debugger. If we simply immediately
signal an UnhandledError, the debugger will catch this and display the signaling context.
It isn't perfect or pretty but it works."
(ProcessBrowser isUIProcess: process)
ifTrue: [UnhandledError signalForException: anError]
ifFalse:
[WorldState addDeferredUIMessage:
[process
debug: anError signalerContext
title: anError description
full: true].
process suspend]
]
stackDepth [
<category: 'exceptions'>
| depth current |
depth := 0.
current := thisContext.
[current isNil] whileFalse:
[current := current parentContext.
depth := depth + 1].
^depth - 1
]
secureHashFor: aString [
<category: 'cryptography'>
^MD5 digestOf: aString
]
]
Eval [
GRGSTPlatform initialize
]

60
grease/GST/Core/GRGSTRandomProvider.st Normal file
View File

@ -0,0 +1,60 @@
GRObject subclass: GRGSTRandomProvider [
<comment: nil>
<category: 'Grease-GST-Core'>
GRGSTRandomProvider class [
| mutex generator |
]
GRGSTRandomProvider class >> initialize [
<category: 'private'>
GRPlatform current addToStartUpList: self.
self startUp
]
GRGSTRandomProvider class >> randomClass [
<category: 'private'>
^Random
]
GRGSTRandomProvider class >> unload [
<category: 'private'>
GRPlatform current removeFromStartUpList: self
]
GRGSTRandomProvider class >> nextInt: anInteger [
"Answer a random integer in the interval [1, anInteger]"
<category: 'public'>
^mutex critical: [generator nextInt: anInteger]
]
GRGSTRandomProvider class >> randomFrom: aCollection [
<category: 'public'>
| random count |
random := self nextInt: aCollection size.
^aCollection isSequenceable
ifTrue: [aCollection at: random]
ifFalse:
[count := 1.
aCollection do:
[:ea |
count = random ifTrue: [^ea].
count := count + 1]]
]
GRGSTRandomProvider class >> startUp [
<category: 'class initialization'>
generator := self randomClass new.
mutex := Semaphore forMutualExclusion
]
]
Eval [
GRGSTRandomProvider initialize
]

4
grease/PORTING Normal file
View File

@ -0,0 +1,4 @@
Grease-Core-obi.30
Grease-Pharo-Core-pmm.13
Grease-Tests-Core-pmm.39
Grease-Tests-Pharo-Core-lr.6

312
grease/PackageBuilder.st Executable file
View File

@ -0,0 +1,312 @@
#!/usr/bin/env gst
"
PackageBuilder.st
by Stefan Schmiedl
with ideas from Nico and Gwen
usage:
PackageBuilder new
name: 'Iliad-Core';
namespace: 'Iliad';
prereq: 'Sport';
prereq: 'Iconv';
...
testBuilder: (TestBuilder on: 'Tests' withExtension: '.st');
filein: 'Utilities/IliadObject.st';
filein: 'Utilities/Support.st';
...
buildXml
"
Object subclass: Indenter [
<comment: 'Decorate a WriteStream with indenting methods.'>
|stream indent indentString|
Indenter class >> on: aStream [
<category: 'instance creation'>
<comment: 'Answer a new indenter writing to aStream.'>
^ self new on: aStream
]
on: aStream [
<category: 'initialization'>
<comment: 'A new indenter starts with no indentation.'>
stream := aStream.
indent := ''.
indentString := ' '
]
indent [
<category: 'indenting'>
<comment: 'Write indent to stream. This assumes that stream is currently at the start of a new line.'>
stream nextPutAll: indent
]
indentMore [
<category: 'indenting'>
<comment: 'Increase indentation, see indentLess.'>
indent := indent , indentString
]
indentLess [
<category: 'indenting'>
<comment: 'Decrease indentation, see indentMore.'>
( indent size < indentString size )
ifTrue: [ indent := '' ]
ifFalse: [
indent := indent allButLast: indentString size
]
]
nextPutAll: aString [
<category: 'streaming'>
stream nextPutAll: aString
]
nextPut: aChar [
<category: 'streaming'>
stream nextPut: aChar
]
tag: aString [
<category: 'xml-printing'>
<comment: 'Write <aString> to stream.'>
stream nextPut: $<; nextPutAll: aString; nextPut: $>
]
indentNl: aBlock [
<category: 'printing'>
<comment: 'Basically printNl with indent. aBlock can use stream as parameter.'>
self indent.
aBlock cull: stream.
stream nl
]
wrap: aString do: aBlock [
<category: 'xml-printing'>
<comment: 'Write opening and closing tags on separate lines, use increased indentation in between.'>
self indentNl: [ self tag: aString ].
self indentMore.
aBlock value.
self indentLess.
self indentNl: [ self tag: '/',aString ].
]
wrap: aString around: contentString [
<category: 'xml-printing'>
<comment: 'Write opening and closing tags on the same line as the contentString.'>
contentString ifNotNil: [
self indentNl: [ :aStream |
self
tag: aString;
nextPutAll: contentString;
tag: '/',aString]]
]
wrap: aString aroundEachOf: aCollection [
<category: 'xml-printing'>
<comment: 'Wrap tag aString around each element of aCollection.'>
aCollection do: [ :item | self wrap: aString around: item ]
]
]
Object subclass: TestBuilder [
<comment: 'A testbuilder scrounges the filesystem for smalltalk files and test cases and writes the gathered data in a format suitable for use in package.xml.'>
| testroot pattern namespace |
testroot [
<category: 'accessing'>
^ testroot
]
testroot: aString [
<category: 'accessing'>
testroot := File name: aString
]
pattern [
<category: 'accessing'>
^ pattern
]
pattern: aString [
<category: 'accessing'>
pattern := aString
]
namespace [
<category: 'accessing'>
^ namespace
]
namespace: aString [
<category: 'accessing'>
namespace := aString
]
collectFiles [
<category: 'accessing'>
<comment: 'Answer a list of files below the testroot directory matching the specified filename pattern.'>
|files|
files := OrderedCollection new.
( self testroot ) allFilesMatching: self pattern do: [ :f |
files add: f
].
^ files
]
collectTestsIn: aCollection [
<category: 'accessing'>
<comment: 'Answer a list of class names highly suspect of being used in SUnit.'>
|tests|
tests := OrderedCollection new.
aCollection do: [ :file |
file contents onOccurrencesOfRegex: 'subclass: (.*Test)' do: [ :rr |
tests add: ( rr at: 1 )
]
].
^ tests
]
renderTests: aCollection on: aStream [
<category: 'accessing'>
<comment: 'Write test class names with package namespace.'>
aStream wrap: 'sunit' do: [
aCollection do: [ :tc |
aStream indentNl: [
aStream
nextPutAll: self namespace;
nextPut: $.;
nextPutAll: tc
]
]
]
]
renderXmlOn: aStream [
<category: 'accessing'>
<comment: 'Write the test subpackage specification to aStream.'>
aStream wrap: 'test' do: [ |files tests paths|
files := self collectFiles.
tests := self collectTestsIn: files.
paths := files collect: [ :f | self testroot parent pathTo: f ].
aStream wrap: 'filein' aroundEachOf: paths.
aStream wrap: 'file' aroundEachOf: paths.
self renderTests: tests on: aStream.
]
]
]
Object subclass: PackageBuilder [
|name url namespace prereqs provides testBuilder start fileins resources|
PackageBuilder class >> new [
^ self basicNew initialize
]
initialize [
prereqs := OrderedCollection new.
provides := OrderedCollection new.
fileins := OrderedCollection new.
resources := OrderedCollection new.
]
name [
<category: 'accessing'>
^ name
]
name: aString [
<category: 'accessing'>
name := aString
]
url [
<category: 'accessing'>
^ url
]
url: aString [
<category: 'accessing'>
url := aString
]
namespace [
<category: 'accessing'>
^ namespace
]
namespace: aString [
<category: 'accessing'>
namespace := aString
]
prereqs [
<category: 'accessing'>
^ prereqs
]
prereq: aString [
<category: 'accessing'>
prereqs add: aString
]
provides [
<category: 'accessing'>
^ provides
]
provides: aString [
<category: 'accessing'>
provides add: aString
]
start [
<category: 'accessing'>
^ start
]
start: aString [
<category: 'accessing'>
start := aString
]
fileins [
<category: 'accessing'>
^ fileins
]
filein: aString [
<category: 'accessing'>
fileins add: aString
]
resource: aString [
<category: 'accessing'>
resources add: aString
]
testsBelow: aDirname matching: aPattern [
<category: 'accessing'>
<comment: 'Make a testbuilder for the given specs.'>
testBuilder :=
TestBuilder new
testroot: aDirname;
pattern: aPattern;
namespace: self namespace.
]
renderXmlOn: aStream [
<category: 'xml-printing'>
<comment: 'Write a representation to aStream suitable for use in package.xml.'>
aStream wrap: 'package' do: [
aStream
wrap: 'name' around: self name;
wrap: 'url' around: self url;
wrap: 'namespace' around: self namespace.
self prereqs do: [ :p | aStream wrap: 'prereq' around: p ].
self provides do: [ :p | aStream wrap: 'provides' around: p ].
testBuilder ifNotNil: [ testBuilder renderXmlOn: aStream ].
aStream wrap: 'filein' aroundEachOf: fileins.
aStream wrap: 'file' aroundEachOf: fileins.
aStream wrap: 'file' aroundEachOf: resources.
aStream wrap: 'start' around: start.
]
]
buildXml [
<category: 'xml-printing'>
<comment: 'This convenience method writes the xml package spec to stdout.'>
self renderXmlOn: ( Indenter on: FileStream stdout )
]
]
Eval [
Smalltalk arguments do: [ :filename | FileStream fileIn: filename ]
]

0
grease/README Normal file
View File

85
grease/Tests/Core/GRAbstractDictionaryTest.st Normal file
View File

@ -0,0 +1,85 @@
GRCollectionTest subclass: GRAbstractDictionaryTest [
| associations |
<comment: nil>
<category: 'Grease-Tests-Core'>
GRAbstractDictionaryTest class >> isAbstract [
<category: 'testing'>
^self name = #GRAbstractDictionaryTest
]
allowsDuplicateValues [
<category: 'configuration'>
^true
]
arbitraryAssociations [
<category: 'configuration'>
^associations ifNil: [associations := self createArbitraryAssociations]
]
arbitraryCollection [
<category: 'configuration'>
| dict |
dict := self emptyCollection.
self arbitraryAssociations do: [:each | dict at: each key put: each value].
^dict
]
createArbitraryAssociations [
<category: 'configuration'>
self subclassResponsibility
]
isKey: anObject equivalentTo: anotherObject [
<category: 'configuration'>
self subclassResponsibility
]
isExtensible [
<category: 'testing-ansi'>
^false
]
isInitializable [
<category: 'testing-ansi'>
^false
]
isSequenced [
<category: 'testing-ansi'>
^false
]
isSequencedReadable [
<category: 'testing-ansi'>
^false
]
testAssociationsDo [
<category: 'tests'>
| collection assocs count |
collection := self arbitraryCollection.
assocs := self arbitraryAssociations copy.
count := 0.
collection associationsDo:
[:assoc |
| size |
count := count + 1.
size := assocs size.
assocs := assocs reject:
[:each |
(self isKey: each key equivalentTo: assoc key)
and: [each value = assoc value]].
self assert: size - 1 = assocs size].
self assert: assocs isEmpty.
self assert: count = self arbitraryAssociations size
]
valuesOf: aCollection [
<category: 'private'>
^aCollection values
]
]

36
grease/Tests/Core/GRArrayTest.st Normal file
View File

@ -0,0 +1,36 @@
GRCollectionTest subclass: GRArrayTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateValues [
<category: 'configuration'>
^true
]
collectionClass [
<category: 'configuration'>
^Array
]
isExtensible [
<category: 'testing-ansi'>
^false
]
isInitializable [
<category: 'testing-ansi'>
^true
]
isSequenced [
<category: 'testing-ansi'>
^true
]
isSequencedReadable [
<category: 'testing-ansi'>
^true
]
]

36
grease/Tests/Core/GRBagTest.st Normal file
View File

@ -0,0 +1,36 @@
GRCollectionTest subclass: GRBagTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateValues [
<category: 'configuration'>
^true
]
collectionClass [
<category: 'configuration'>
^Bag
]
isExtensible [
<category: 'testing-ansi'>
^true
]
isInitializable [
<category: 'testing-ansi'>
^true
]
isSequenced [
<category: 'testing-ansi'>
^false
]
isSequencedReadable [
<category: 'testing-ansi'>
^false
]
]

122
grease/Tests/Core/GRCodecTest.st Normal file
View File

@ -0,0 +1,122 @@
TestCase subclass: GRCodecTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
decodedString [
<category: 'accessing'>
^'Übèrstrîñgé'
]
latin1String [
<category: 'accessing'>
^self
asString: #(220 98 232 114 115 116 114 238 241 103 233)
]
macromanString [
<category: 'accessing'>
^self
asString: #(134 98 143 114 115 116 114 148 150 103 142)
]
utf16beString [
<category: 'accessing'>
^self
asString: #(0 220 0 98 0 232 0 114 0 115 0 116 0 114 0 238 0 241 0 103 0 233)
]
utf16leString [
<category: 'accessing'>
^self
asString: #(220 0 98 0 232 0 114 0 115 0 116 0 114 0 238 0 241 0 103 0 233 0)
]
utf8String [
<category: 'accessing'>
^self
asString: #(195 156 98 195 168 114 115 116 114 195 174 195 177 103 195 169)
]
testAllCodecs [
<category: 'testing'>
self assert: GRCodec allCodecs notEmpty.
GRCodec allCodecs do:
[:codec |
self deny: codec class = GRCodec.
self assert: (codec isKindOf: GRCodec)]
]
testCodecLatin1 [
<category: 'testing'>
#('iso-8859-1' 'ISO-8859-1') do:
[:each |
| codec |
codec := GRCodec forEncoding: each.
self assert: codec name = each.
self assert: codec url name = each.
self assert: (codec encode: self decodedString) = self latin1String.
self assert: (codec url encode: self decodedString) = self latin1String.
self assert: (codec decode: self latin1String) = self decodedString.
self assert: (codec url decode: self latin1String) = self decodedString]
]
testNext [
<category: 'testing'>
#('iso-8859-1' 'ISO-8859-1') do:
[:each |
| stream |
stream := (GRCodec forEncoding: each)
encoderFor: self seasideByteArray readStream.
self assert: stream next = $S.
self assert: (stream next: 1) = 'e']
]
testNullCodec [
<category: 'testing'>
| codec readStream writeStream strings |
codec := GRNullCodec new.
readStream := self latin1String readStream.
writeStream := WriteStream on: String new.
strings := (OrderedCollection new)
add: self latin1String;
add: self utf8String;
add: self utf16leString;
add: self utf16beString;
add: self macromanString;
yourself.
strings do:
[:string |
self assert: (codec encode: string) = string.
self assert: (codec url encode: string) = string.
self assert: (codec decode: string) = string.
self assert: (codec url decode: string) = string].
strings do:
[:string |
| binary encoded |
binary := string asByteArray.
encoded := (codec encoderFor: (WriteStream on: String new))
binary;
nextPutAll: binary;
contents.
self assert: encoded = string.
encoded := (codec url encoderFor: (WriteStream on: String new))
binary;
nextPutAll: binary;
contents.
self assert: encoded = string]
]
asString: aCollectionOfIntegers [
<category: 'private'>
^String streamContents:
[:stream |
aCollectionOfIntegers
do: [:each | stream nextPut: (Character value: each)]]
]
seasideByteArray [
<category: 'private'>
^#(83 101 97 115 105 100 101) asByteArray "Seaside"
]
]

291
grease/Tests/Core/GRCollectionTest.st Normal file
View File

@ -0,0 +1,291 @@
TestCase subclass: GRCollectionTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
GRCollectionTest class >> isAbstract [
<category: 'testing'>
^self name = #GRCollectionTest
]
allowsDuplicateValues [
"Does the tested collection allow storage of duplicate (equal) values."
<category: 'configuration'>
self subclassResponsibility
]
arbitraryCollection [
"An general collection for testing. It should meet the needs of #duplicateElement,
#excludedElement, #includedElement, and so on where appropriate."
<category: 'configuration'>
^self collectionClass withAll: #(3 1 2 1 4)
]
collectionClass [
"Answer the collection class that is being tested."
<category: 'configuration'>
self subclassResponsibility
]
duplicateElement [
"Answer an element that appears multiple times in #arbitraryCollection."
<category: 'configuration'>
^1
]
emptyCollection [
"Answer an empty collection."
<category: 'configuration'>
^self collectionClass new
]
excludedElement [
"Answer an element that does not appear in #arbitraryCollection."
<category: 'configuration'>
^19
]
includedElement [
"Answer a (non-duplicate) element that does appear in #arbitraryCollection."
<category: 'configuration'>
^2
]
isValidNewSequencedResponseClass: aClass [
"Answer whether aClass is a valid return type for methods that return a new sequenced
collection. These are methods such as #copyFrom:to: or #reversed, which are
defined by ANSI for most classes to return the same class as the receiver.
For Interval (and may other cases), however, ANSI specifies that the response
may be any <sequencedReadableCollection."
<category: 'configuration'>
^self isSequencedReadable
ifTrue:
[aClass == self collectionClass
or: [aClass allSuperclasses includes: self collectionClass]]
ifFalse: [aClass == Array or: [aClass allSuperclasses includes: Array]]
]
assert: aCollection sortedWith: sortBlock [
"Assert that aCollection is correctly sorted according to sortBlock."
<category: 'asserting'>
1 to: aCollection size - 1
do:
[:index |
| a b |
a := aCollection at: index.
b := aCollection at: index + 1.
self assert: ((sortBlock value: a value: b)
or: [(sortBlock value: b value: a) not])]
]
assert: responseCollection validSequencedNewResponseFrom: receiverCollection [
"Assert that the returned object is, in fact a new object, and that it is
of a valid response class for the tested collection."
<category: 'asserting'>
self deny: responseCollection == receiverCollection.
self
assert: (self isValidNewSequencedResponseClass: responseCollection class)
]
isExtensible [
"Answer whether the tested Collection implements the <extensibleCollection>
protocol as defined in ANSI 5.7.5 ."
<category: 'testing-ansi'>
self subclassResponsibility
]
isInitializable [
"Answer whether the tested Collection implements the <initializableCollection factory>
protocol as defined in ANSI 5.7.23."
<category: 'testing-ansi'>
self subclassResponsibility
]
isSequenced [
"Answer whether the tested Collection implements the <sequencedCollection>
protocol as defined in ANSI 5.7.12."
<category: 'testing-ansi'>
self subclassResponsibility
]
isSequencedReadable [
"Answer whether the tested Collection implements the <sequencedReadableCollection>
protocol as defined in ANSI 5.7.8."
<category: 'testing-ansi'>
self subclassResponsibility
]
testAddFirst [
<category: 'tests'>
| collection |
(self isExtensible and: [self isSequenced]) ifFalse: [^self].
collection := self arbitraryCollection.
collection addFirst: self excludedElement.
self assert: (collection at: 1) = self excludedElement.
self assert: (collection copyFrom: 2 to: collection size)
= self arbitraryCollection
]
testAny [
<category: 'tests'>
| collection |
collection := self arbitraryCollection.
self assert: ((self valuesOf: collection) includes: collection any)
]
testCopyUpTo [
<category: 'tests'>
| collection sub |
self isSequencedReadable ifFalse: [^self].
"match first element"
collection := self arbitraryCollection.
sub := collection copyUpTo: (collection at: 1).
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub isEmpty.
"no match"
sub := collection copyUpTo: self excludedElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub size = collection size.
self assert: sub = collection.
"match an element"
sub := collection copyUpTo: self includedElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub = (collection copyFrom: 1 to: sub size).
self assert: (collection at: sub size + 1) = self includedElement.
self allowsDuplicateValues
ifTrue:
[sub := collection copyUpTo: self duplicateElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub = (collection copyFrom: 1 to: sub size).
self assert: (collection at: sub size + 1) = self duplicateElement.
self deny: (sub includes: self duplicateElement)].
"Make sure we're using equality"
self isInitializable
ifTrue:
[collection := self collectionClass withAll: #(1 '1').
sub := collection copyUpTo: '1'.
self assert: sub size = 1.
self assert: (sub at: 1) = 1]
]
testCopyUpToLast [
<category: 'tests'>
| collection sub |
self isSequencedReadable ifFalse: [^self].
"match first element"
collection := self arbitraryCollection.
sub := collection copyUpToLast: collection first.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub isEmpty.
"no match"
sub := collection copyUpToLast: self excludedElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub size = collection size.
self assert: sub = collection.
"match an element"
sub := collection copyUpToLast: self includedElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub = (collection copyFrom: 1 to: sub size).
self assert: (collection at: sub size + 1) = self includedElement.
self allowsDuplicateValues
ifTrue:
[sub := collection copyUpToLast: self duplicateElement.
self assert: sub validSequencedNewResponseFrom: collection.
self assert: sub = (collection copyFrom: 1 to: sub size).
self assert: (collection at: sub size + 1) = self duplicateElement.
self assert: (sub includes: self duplicateElement)].
"Make sure we're using equality"
self isInitializable
ifTrue:
[collection := self collectionClass withAll: #(1 '1').
sub := collection copyUpToLast: '1'.
self assert: sub size = 1.
self assert: sub first = 1]
]
testEmptyAny [
<category: 'tests'>
| collection |
collection := self emptyCollection.
self should: [(self valuesOf: collection) includes: collection any]
raise: Error
]
testIsCollection [
<category: 'tests'>
self assert: self arbitraryCollection isCollection
]
testNoneSatisfy [
<category: 'tests'>
| excluded included |
excluded := self excludedElement.
self
assert: (self arbitraryCollection noneSatisfy: [:each | each = excluded]).
included := self includedElement.
self
deny: (self arbitraryCollection noneSatisfy: [:each | each = included]).
self assert: (self emptyCollection noneSatisfy: [:each | true])
]
testNotEmpty [
<category: 'tests'>
self assert: self arbitraryCollection notEmpty.
self deny: self emptyCollection notEmpty.
self assert: self arbitraryCollection notEmpty.
self deny: self emptyCollection notEmpty
]
testSort [
<category: 'tests'>
| collection |
self isSequenced ifFalse: [^self].
collection := self arbitraryCollection.
collection sort.
self assert: collection sortedWith: [:a :b | a <= b].
collection sort: [:a :b | a > b].
self assert: collection sortedWith: [:a :b | a > b]
]
testSorted [
<category: 'tests'>
| sorted collection |
collection := self arbitraryCollection.
sorted := collection sorted.
self assert: sorted validSequencedNewResponseFrom: collection.
self assert: sorted sortedWith: [:a :b | a <= b].
sorted := collection sorted: [:a :b | a > b].
self assert: sorted validSequencedNewResponseFrom: collection.
self assert: sorted sortedWith: [:a :b | a > b]
]
valuesOf: aCollection [
"Answer the values of aCollecion. Dictionary tests override this."
<category: 'private'>
^aCollection
]
]

322
grease/Tests/Core/GRDelayedSendTest.st Normal file
View File

@ -0,0 +1,322 @@
TestCase subclass: GRDelayedSendTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
testArgumentCount [
"unary"
<category: 'testing-accessing'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self assert: send argumentCount = 0.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self assert: send argumentCount = 0.
"binary"
send := GRDelayedSend receiver: 1 selector: #+.
self assert: send argumentCount = 1.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: send argumentCount = 0.
"keyword"
send := GRDelayedSend receiver: 1 selector: #between:and:.
self assert: send argumentCount = 2.
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self assert: send argumentCount = 1.
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self assert: send argumentCount = 0
]
testFixCallbackTemps [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self assert: send fixCallbackTemps == send.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: send fixCallbackTemps == send
]
testValueBinary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self should: [send value] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: send value = 3
]
testValueKeyword [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #between:and:.
self should: [send value] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self should: [send value] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self deny: send value
]
testValueUnary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self assert: send value = -1.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self assert: send value = -1
]
testValueValueBinary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self should: [send value: 2 value: 3] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self should: [send value: 2 value: 3] raise: GRInvalidArgumentCount
]
testValueValueKeyword [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #between:and:.
self deny: (send value: 2 value: 3).
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self should: [send value: 4 value: 5] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self should: [send value: 4 value: 5] raise: GRInvalidArgumentCount
]
testValueValueUnary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self should: [send value: 2 value: 3] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self should: [send value: 2 value: 3] raise: GRInvalidArgumentCount
]
testValueWithArgumentBinary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self assert: (send value: 2) = 3.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self should: [send value: 2] raise: GRInvalidArgumentCount
]
testValueWithArgumentKeyword [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #between:and:.
self should: [send value: 2] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self deny: (send value: 3).
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: #(2 3).
self should: [send value: 4] raise: GRInvalidArgumentCount
]
testValueWithArgumentUnary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self should: [send value: 2] raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self should: [send value: 2] raise: GRInvalidArgumentCount
]
testValueWithArgumentsBinary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self should: [send valueWithArguments: #(2 3)]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self should: [send valueWithArguments: #(3 4)]
raise: GRInvalidArgumentCount
]
testValueWithArgumentsKeyword [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #between:and:.
self deny: (send valueWithArguments: #(2 3)).
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self should: [send valueWithArguments: #(3 4)]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: #(2 3).
self should: [send valueWithArguments: #(4 5)]
raise: GRInvalidArgumentCount
]
testValueWithArgumentsUnary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self should: [send valueWithArguments: #(2 3)]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self should: [send valueWithArguments: #(2 3)]
raise: GRInvalidArgumentCount
]
testValueWithPossibleArgumentsBinary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #+.
self should: [send valueWithPossibleArguments: #()]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: (send valueWithPossibleArguments: #()) = 3.
send := GRDelayedSend receiver: 1 selector: #+.
self assert: (send valueWithPossibleArguments: #(2)) = 3.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: (send valueWithPossibleArguments: #(3)) = 3.
send := GRDelayedSend receiver: 1 selector: #+.
self assert: (send valueWithPossibleArguments: #(2 3)) = 3.
send := GRDelayedSend
receiver: 1
selector: #+
argument: 2.
self assert: (send valueWithPossibleArguments: #(3 4)) = 3
]
testValueWithPossibleArgumentsKeyword [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #between:and:.
self should: [send valueWithPossibleArguments: #()]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self should: [send valueWithPossibleArguments: #()]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self deny: (send valueWithPossibleArguments: #()).
send := GRDelayedSend receiver: 1 selector: #between:and:.
self should: [send valueWithPossibleArguments: #(2)]
raise: GRInvalidArgumentCount.
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self deny: (send valueWithPossibleArguments: #(3)).
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self deny: (send valueWithPossibleArguments: #(4)).
send := GRDelayedSend receiver: 1 selector: #between:and:.
self deny: (send valueWithPossibleArguments: #(2 3)).
send := GRDelayedSend
receiver: 1
selector: #between:and:
argument: 2.
self deny: (send valueWithPossibleArguments: #(3 4)).
send := GRDelayedSend
receiver: 1
selector: #between:and:
arguments: (Array with: 2 with: 3).
self deny: (send valueWithPossibleArguments: #(4 5))
]
testValueWithPossibleArgumentsUnary [
<category: 'testing-evaluating'>
| send |
send := GRDelayedSend receiver: 1 selector: #negated.
self assert: (send valueWithPossibleArguments: #()) = -1.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self assert: (send valueWithPossibleArguments: #()) = -1.
send := GRDelayedSend receiver: 1 selector: #negated.
self assert: (send valueWithPossibleArguments: #(2)) = -1.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self assert: (send valueWithPossibleArguments: #(2)) = -1.
send := GRDelayedSend receiver: 1 selector: #negated.
self assert: (send valueWithPossibleArguments: #(2 3)) = -1.
send := GRDelayedSend
receiver: 1
selector: #negated
arguments: #().
self assert: (send valueWithPossibleArguments: #(2 3)) = -1
]
]

27
grease/Tests/Core/GRDictionaryTest.st Normal file
View File

@ -0,0 +1,27 @@
GRAbstractDictionaryTest subclass: GRDictionaryTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
collectionClass [
<category: 'configuration'>
^Dictionary
]
createArbitraryAssociations [
<category: 'configuration'>
^(OrderedCollection new)
add: #c -> 3;
add: #a -> 1;
add: #b -> 2;
add: #e -> 1;
add: #d -> 4;
yourself
]
isKey: anObject equivalentTo: anotherObject [
<category: 'configuration'>
^anObject = anotherObject
]
]

133
grease/Tests/Core/GRDurationTest.st Normal file
View File

@ -0,0 +1,133 @@
TestCase subclass: GRDurationTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
testAccessors [
<category: 'tests'>
| duration |
duration := Duration seconds: 356521.
self assert: duration days = 4.
self assert: duration hours = 3.
self assert: duration minutes = 2.
self assert: duration seconds = 1.
self assert: duration milliseconds = 0
]
testBasicInstanceCreation [
<category: 'tests'>
self
assert: (Duration
days: 1
hours: 1
minutes: 1
seconds: 1) asMilliseconds
= 90061000.
self assert: (Duration weeks: 1) asMilliseconds = 604800000.
self assert: (Duration days: 1) asMilliseconds = 86400000.
self assert: (Duration hours: 1) asMilliseconds = 3600000.
self assert: (Duration minutes: 1) asMilliseconds = 60000.
self assert: (Duration seconds: 1) asMilliseconds = 1000.
self assert: (Duration milliseconds: 1) asMilliseconds = 1
]
testConversions [
<category: 'tests'>
| duration |
duration := Duration
days: 4
hours: 3
minutes: 2
seconds: 1.
self assert: duration asSeconds = 356521.
self assert: duration asMilliseconds = 356521000.
self assert: duration negated asSeconds = -356521.
self assert: duration negated asMilliseconds = -356521000
]
testMixedInstanceCreation [
<category: 'tests'>
self
assert: (Duration
days: 1
hours: -23
minutes: 1
seconds: -59) asMilliseconds
= 3601000
]
testNegativeInstanceCreation [
<category: 'tests'>
self
assert: (Duration
days: -1
hours: -1
minutes: -1
seconds: -1) asMilliseconds
= -90061000.
self assert: (Duration weeks: -1) asMilliseconds = -604800000.
self assert: (Duration days: -1) asMilliseconds = -86400000.
self assert: (Duration hours: -1) asMilliseconds = -3600000.
self assert: (Duration minutes: -1) asMilliseconds = -60000.
self assert: (Duration seconds: -1) asMilliseconds = -1000.
self assert: (Duration milliseconds: -1) asMilliseconds = -1
]
testPartialSecondsInstanceCreation [
"ANSI 5.8.3.1 and 5.8.3.2 specify that the seconds argument can be any
Number - not just an integer as is the case for the other arguments."
<category: 'tests'>
self
assert: (Duration
days: 0
hours: 0
minutes: 0
seconds: 1.5) asMilliseconds
= 1500.
self
assert: (Duration
days: 0
hours: 0
minutes: 0
seconds: 3 / 2) asMilliseconds
= 1500.
self assert: (Duration seconds: 1.5) asMilliseconds = 1500.
self assert: (Duration seconds: 3 / 2) asMilliseconds = 1500
]
testRolloverInstanceCreation [
<category: 'tests'>
self
assert: (Duration
days: 0
hours: 25
minutes: 61
seconds: 61) asMilliseconds
= 93721000.
self assert: (Duration hours: 25) asMilliseconds = 90000000.
self assert: (Duration minutes: 61) asMilliseconds = 3660000.
self assert: (Duration seconds: 61) asMilliseconds = 61000.
self assert: (Duration milliseconds: 1001) asMilliseconds = 1001
]
testZero [
<category: 'tests'>
| duration |
duration := Duration zero.
self assert: duration isZero.
self assert: duration asMilliseconds = 0.
self assert: duration = (Duration seconds: 0)
]
testIntegerConvenienceMethods [
<category: 'testing'>
self assert: 5 weeks = (Duration weeks: 5).
self assert: 5 days = (Duration days: 5).
self assert: 5 hours = (Duration hours: 5).
self assert: 5 minutes = (Duration minutes: 5).
self assert: 5 seconds = (Duration seconds: 5).
self assert: 5 milliseconds = (Duration milliseconds: 5)
]
]

17
grease/Tests/Core/GRErrorStub.st Normal file
View File

@ -0,0 +1,17 @@
GRError subclass: GRErrorStub [
| foo |
<category: 'Grease-Tests-Core'>
<comment: nil>
initialize [
<category: 'initialization'>
super initialize.
foo := true
]
foo [
<category: 'accessing'>
^foo
]
]

207
grease/Tests/Core/GRExceptionTest.st Normal file
View File

@ -0,0 +1,207 @@
TestCase subclass: GRExceptionTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
testDefaultActionResume [
"According to ANSI 5.5.15.2, the result of #defaultAction
should be used to resume resumable exceptions. Behaviour is undefined
for non-resumable exceptions so we do not test for that case."
<category: 'tests'>
| result |
result := GRNotificationStub signal.
self assert: result = #returnValue
]
testDeprecatedApi [
<category: 'tests'>
| exception seen |
exception := seen := nil.
[self greaseDeprecatedApi: 'GRExceptionTest>>#testDeprecatedApi'
details: 'Message in a bottle.'.
seen := true]
on: GRDeprecatedApiNotification
do:
[:notification |
exception := notification.
exception resume.
seen := false].
self assert: seen.
self assert: exception notNil.
self assert: exception messageText = 'GRExceptionTest>>#testDeprecatedApi'.
self assert: exception details = 'Message in a bottle.'
]
testErrorInitialization [
"Make sure #initialize is called on #new and that calling 'super initialize' doesn't error."
<category: 'tests'>
self assert: GRErrorStub new foo
]
testIsResumable [
"Make sure the platform class provides #isResumable on Exception.
This test made a bit more complex by James Foster per issue #259
for GemStone portability."
<category: 'tests'>
| exception |
[Exception signal] on: Exception
do:
[:ex |
exception := ex.
ex return].
self shouldnt: [exception isResumable] raise: MessageNotUnderstood
]
testNotificationInitialization [
"Make sure #initialize is called on #new and that calling 'super initialize' doesn't error."
<category: 'tests'>
self assert: GRNotificationStub new foo
]
testOnDoImplicitReturn [
"According to ANSI 5.5.15.2, an exception handler block that runs to completion
should result in the call to #on:do: returning the block's value."
<category: 'tests'>
| result |
result := [GRErrorStub signal] on: GRErrorStub do: [:e | #blockValue].
self assert: result = #blockValue.
result := nil.
result := [GRNotificationStub signal] on: GRNotificationStub
do: [:e | #blockValue].
self assert: result = #blockValue
]
testOnDoNonLocalReturn [
"You should be able to do a non-local return from within an exception
handler block. We rely on a helper method here so we can check the return
value."
<category: 'tests'>
self assert: (self onExceptionReturn: 123) == 123
]
testSignalError [
"Exception>>signal is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
[GRError new signal] on: GRError do: [:e | ^self].
self assert: false
]
testSignalErrorClassSide [
"Exception class>>signal is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
[GRError signal] on: GRError do: [:e | ^self].
self assert: false
]
testSignalNotification [
"Exception>>signal is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
[GRNotification new signal] on: GRNotification do: [:e | ^self].
self assert: false
]
testSignalNotificationClassSide [
"Exception class>>signal is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
[GRNotification signal] on: GRNotification do: [:e | ^self].
self assert: false
]
testSignalWithError [
"Exception>>signal: is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
| text |
text := 'Error!'.
[GRError new signal: text] on: GRError
do:
[:e |
self assert: e messageText = text.
^self].
self assert: false
]
testSignalWithErrorClassSide [
"Exception class>>signal: is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
| text |
text := 'Error!'.
[GRError signal: text] on: GRError
do:
[:e |
self assert: e messageText = text.
^self].
self assert: false
]
testSignalWithNotification [
"Exception>>signal: is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
| text |
text := 'Notification'.
[GRNotification new signal: text] on: GRNotification
do:
[:e |
self assert: e messageText = text.
^self].
self assert: false
]
testSignalWithNotificationClassSide [
"Exception class>>signal: is part of the ANSI Smalltalk standard. However, Seaside
only signals subclasses of WAPlatformError and WAPlatformNotification so Smalltalk
implementations that do not otherwise provide it can implement it on
these two classes."
<category: 'tests'>
| text |
text := 'Notification'.
[GRNotification signal: text] on: GRNotification
do:
[:e |
self assert: e messageText = text.
^self].
self assert: false
]
onExceptionReturn: anObject [
<category: 'private'>
[GRError signal] on: GRError do: [:ex | ^anObject].
^self
]
]

27
grease/Tests/Core/GRIdentityDictionaryTest.st Normal file
View File

@ -0,0 +1,27 @@
GRAbstractDictionaryTest subclass: GRIdentityDictionaryTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
collectionClass [
<category: 'configuration'>
^IdentityDictionary
]
createArbitraryAssociations [
<category: 'configuration'>
^(OrderedCollection new)
add: 'c' -> 3;
add: 'a' -> 1;
add: 'b' -> 2;
add: 'd' -> 1;
add: 'b' copy -> 4;
yourself
]
isKey: anObject equivalentTo: anotherObject [
<category: 'configuration'>
^anObject == anotherObject
]
]

52
grease/Tests/Core/GRIntervalTest.st Normal file
View File

@ -0,0 +1,52 @@
GRCollectionTest subclass: GRIntervalTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateValues [
<category: 'configuration'>
^false
]
arbitraryCollection [
<category: 'configuration'>
^1 to: 4
]
collectionClass [
<category: 'configuration'>
^Interval
]
emptyCollection [
<category: 'configuration'>
^1 to: 0
]
isValidNewSequencedResponseClass: aClass [
<category: 'configuration'>
^aClass == SequenceableCollection
or: [aClass allSuperclasses includes: SequenceableCollection]
]
isExtensible [
<category: 'testing-ansi'>
^false
]
isInitializable [
<category: 'testing-ansi'>
^false
]
isSequenced [
<category: 'testing-ansi'>
^false
]
isSequencedReadable [
<category: 'testing-ansi'>
^true
]
]

23
grease/Tests/Core/GRNotificationStub.st Normal file
View File

@ -0,0 +1,23 @@
GRNotification subclass: GRNotificationStub [
| foo |
<comment: nil>
<category: 'Grease-Tests-Core'>
defaultAction [
<category: 'accessing'>
^#returnValue
]
foo [
<category: 'accessing'>
^foo
]
initialize [
<category: 'initialization'>
super initialize.
foo := true
]
]

100
grease/Tests/Core/GRNullCodecStreamTest.st Normal file
View File

@ -0,0 +1,100 @@
TestCase subclass: GRNullCodecStreamTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
codecStreamClass [
<category: 'accessing'>
^GRNullCodecStream
]
seasideByteArray [
<category: 'private'>
^#(83 101 97 115 105 100 101) asByteArray "Seaside"
]
testCrlf [
<category: 'testing-characters'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
stream crlf.
self assert: stream contents size = 2.
self assert: stream contents first = Character cr.
self assert: stream contents last = Character lf
]
testSpace [
<category: 'testing-characters'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
stream space.
self assert: stream contents size = 1.
self assert: stream contents first = Character space
]
testTab [
<category: 'testing-characters'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
stream tab.
self assert: stream contents size = 1.
self assert: stream contents first = Character tab
]
testFlush [
<category: 'testing-protocol'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
stream nextPutAll: 'abc'.
self shouldnt: [stream flush] raise: Error.
self assert: stream contents = 'abc'
]
testNext [
<category: 'testing-protocol'>
| stream |
stream := GRNullCodec new encoderFor: 'Seaside' readStream.
self assert: stream next = $S.
self assert: (stream next: 1) = 'e'
]
testSize [
<category: 'testing-protocol'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
stream nextPutAll: 'abc'.
self assert: stream size = 3.
stream nextPut: $d.
self assert: stream size = 4
]
testText [
<category: 'testing-protocol'>
| stream |
stream := GRNullCodec new encoderFor: (WriteStream on: String new).
self shouldnt: [stream text] raise: Error
]
testReadString [
<category: 'testing'>
| stream codecStream |
stream := 'abc' readStream.
codecStream := GRNullCodec new decoderFor: stream.
self assert: codecStream next = $a.
self assert: (codecStream next: 2) = 'bc'
]
testWriteString [
<category: 'testing'>
| stream codecStream |
stream := WriteStream on: String new.
codecStream := GRNullCodec new encoderFor: stream.
codecStream
nextPut: $A;
nextPutAll: 'BC';
nextPut: 68;
nextPutAll: #(69 70) asByteArray.
self assert: codecStream contents = 'ABCDEF'
]
]

107
grease/Tests/Core/GRNumberTest.st Normal file
View File

@ -0,0 +1,107 @@
TestCase subclass: GRNumberTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
testBetweenAnd [
<category: 'testing'>
self assert: (6 between: 1 and: 12)
]
testPluralize [
<category: 'testing'>
self assert: (0 pluralize: 'person') = '0 people'.
self assert: (1 pluralize: 'person') = '1 person'.
self assert: (2 pluralize: 'person') = '2 people'.
self assert: (3 pluralize: 'person') = '3 people'.
self assert: (0 pluralize: 'penis') = '0 penises'.
self assert: (1 pluralize: 'penis') = '1 penis'.
self assert: (2 pluralize: 'penis') = '2 penises'.
self assert: (0 pluralize: 'person' with: 'members') = '0 members'.
self assert: (1 pluralize: 'person' with: 'members') = '1 person'.
self assert: (2 pluralize: 'person' with: 'members') = '2 members'.
self assert: (3 pluralize: 'person' with: 'members') = '3 members'.
]
testReadFrom [
"We test #readFrom: as the expected behaviour on all platforms, as we
rely on it for WANumberAttribute and WAQualifiedValue"
<category: 'testing'>
self assert: (Number readFrom: '123' readStream) = 123.
self assert: (Float readFrom: '123.45' readStream) = 123.45.
self assert: (Number readFrom: '123.45' readStream) = 123.45.
"This final test may not be correct. This is the expected behaviour
in Pharo. VisualWorks & GemStone64"
self assert: (Number readFrom: 'seaside' readStream) = 0.
self assert: (Float readFrom: 'seaside' readStream) = 0.0.
]
testTo [
<category: 'testing'>
| collection |
collection := OrderedCollection new.
(1 to: 5) do: [:ea | collection add: ea].
self assert: collection asArray = #(1 2 3 4 5).
collection := OrderedCollection new.
(4 to: 4) do: [:ea | collection add: ea].
self assert: collection asArray = #(4).
collection := OrderedCollection new.
(5 to: 4) do: [:ea | collection add: ea].
self assert: collection asArray = #().
collection := OrderedCollection new.
(-3 to: -1.5) do: [:ea | collection add: ea].
self assert: collection asArray = #(-3 -2).
collection := OrderedCollection new.
(1.5 to: 4) do: [:ea | collection add: ea].
self assert: collection asArray = #(1.5 2.5 3.5)
]
testToDo [
<category: 'testing'>
| collection |
collection := OrderedCollection new.
1 to: 5 do: [:ea | collection add: ea].
self assert: collection asArray = #(1 2 3 4 5).
collection := OrderedCollection new.
4 to: 4 do: [:ea | collection add: ea].
self assert: collection asArray = #(4).
collection := OrderedCollection new.
5 to: 4 do: [:ea | collection add: ea].
self assert: collection asArray = #().
collection := OrderedCollection new.
-3 to: -1.5 do: [:ea | collection add: ea].
self assert: collection asArray = #(-3 -2).
collection := OrderedCollection new.
1.5 to: 4 do: [:ea | collection add: ea].
self assert: collection asArray = #(1.5 2.5 3.5)
]
testToDoClosures [
"#to:do: may be optimized and VAST currently has problems with closures
in this case. We would prefer to use the optimized version than than
(1 to: 5) do: [ ... ] so this test is here to hilight the problem at
least unless the platforms tell us the problem is not fixable."
<category: 'testing'>
| collection |
collection := OrderedCollection new.
1 to: 5 do: [:ea | collection add: [ea] fixCallbackTemps].
self assert: (collection collect: [:ea | ea value]) asArray = #(1 2 3 4 5)
]
]

18
grease/Tests/Core/GRObjectStub.st Normal file
View File

@ -0,0 +1,18 @@
GRObject subclass: GRObjectStub [
| foo |
<comment: nil>
<category: 'Grease-Tests-Core'>
foo [
<category: 'accessing'>
^foo
]
initialize [
<category: 'initialization'>
super initialize.
foo := true
]
]

22
grease/Tests/Core/GRObjectTest.st Normal file
View File

@ -0,0 +1,22 @@
TestCase subclass: GRObjectTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
testError [
"Make sure #error: signals a subclass of WAPlatformError."
<category: 'testing'>
self should: [GRObject new error: 'oh dear'] raise: GRError.
self should: [GRObject error: 'oh dear'] raise: GRError
]
testInitialize [
"Make sure #initialize is called on #new and that calling
'super initialize' doesn't error."
<category: 'testing'>
self assert: GRObjectStub new foo
]
]

36
grease/Tests/Core/GROrderedCollectionTest.st Normal file
View File

@ -0,0 +1,36 @@
GRCollectionTest subclass: GROrderedCollectionTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateValues [
<category: 'configuration'>
^true
]
collectionClass [
<category: 'configuration'>
^OrderedCollection
]
isExtensible [
<category: 'testing-ansi'>
^true
]
isInitializable [
<category: 'testing-ansi'>
^true
]
isSequenced [
<category: 'testing-ansi'>
^true
]
isSequencedReadable [
<category: 'testing-ansi'>
^true
]
]

44
grease/Tests/Core/GROrderedMultiMapTest.st Normal file
View File

@ -0,0 +1,44 @@
GRSmallDictionaryTest subclass: GROrderedMultiMapTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
GROrderedMultiMapTest class >> shouldInheritSelectors [
<category: 'testing'>
^true
]
allowsDuplicateKeys [
<category: 'configuration'>
^true
]
collectionClass [
<category: 'configuration'>
^GROrderedMultiMap
]
testAllAt [
<category: 'tests-accessing'>
self assert: (collection allAt: '1') = #().
collection at: '1' add: 'foo'.
collection at: '1' add: 'bar'.
self assert: (collection allAt: '1') = #('foo' 'bar')
]
testAllAtIfAbsent [
<category: 'tests-accessing'>
self assert: (collection allAt: '1' ifAbsent: ['absent']) = 'absent'.
collection at: '1' add: 'foo'.
collection at: '1' add: 'bar'.
self assert: (collection allAt: '1' ifAbsent: ['absent']) = #('foo' 'bar')
]
testAtAdd [
<category: 'tests-accessing'>
collection at: '1' add: 'foo'.
collection at: '1' add: 'bar'.
self assertAssociations: (Array with: '1' -> 'foo' with: '1' -> 'bar')
]
]

92
grease/Tests/Core/GRPackageTest.st Normal file
View File

@ -0,0 +1,92 @@
TestCase subclass: GRPackageTest [
| package |
<comment: nil>
<category: 'Grease-Tests-Core'>
setUp [
<category: 'running'>
super setUp.
package := GRPackage new
]
testAllDependencies [
<category: 'testing-dependencies'>
| packages |
packages := Dictionary new.
packages
at: 'Lust'
put: ((GRPackage new)
name: 'Lust';
addDependency: 'Gluttony';
addDependency: 'Greed';
yourself);
at: 'Gluttony'
put: ((GRPackage new)
name: 'Gluttony';
addDependency: 'Greed';
yourself);
at: 'Greed'
put: ((GRPackage new)
name: 'Greed';
yourself).
packages values do: [:each | each resolveWith: packages].
self assert: (packages at: 'Lust') allDependencies size = 3.
self assert: (packages at: 'Gluttony') allDependencies size = 2.
self assert: (packages at: 'Greed') allDependencies size = 1
]
testDependencies [
<category: 'testing-dependencies'>
self assert: package dependencies isEmpty.
package addDependency: 'Lust'.
package addDependency: 'Envy'.
self assert: package dependencies size = 2.
self assert: package dependencies first = 'Lust'.
self assert: package dependencies last = 'Envy'
]
testDescription [
<category: 'testing'>
self assert: package description isNil.
package description: 'A hopeless pacakge'.
self assert: package description = 'A hopeless pacakge'
]
testLicense [
<category: 'testing'>
self assert: package license = #MIT.
self assert: package isMIT.
package license: #LGPL.
self assert: package license = #LGPL.
self assert: package isLGPL
]
testName [
<category: 'testing'>
self assert: package name isNil.
package name: 'Gimme-Hope'.
self assert: package name = 'Gimme-Hope'
]
testUrl [
<category: 'testing'>
self assert: package url isNil.
package url: #seasideLGPLUrl.
self assert: package url = GRPackage new seasideLGPLUrl.
package url: 'http://www.seaside.st/distributions'.
self assert: package url = 'http://www.seaside.st/distributions'
]
testPackages [
<category: 'testing-packages'>
| packages |
packages := GRPackage packages.
self assert: packages notEmpty.
packages do: [:each |
self assert: each name notEmpty.
self assert: each license notNil.
self assert: each url notNil]
]
]

939
grease/Tests/Core/GRPlatformTest.st Normal file
View File

@ -0,0 +1,939 @@
TestCase subclass: GRPlatformTest [
<comment: 'A WAPlatformTest is a test to make sure the platform (= the
Smalltalk dialect we are running on) implements the protocol we need for
system classes like Collection. An example would be to make sure Collection
implements #count: with the sementics we need.'>
<category: 'Grease-Tests-Core'>
decodeUtf8Character: aCollectionOfIntegers [
"Decodes a collection of bytes into a single character. We have this so
we can avoid having non-ASCII characters in the source."
<category: 'private'>
| codec toDecode decoded |
codec := GRCodec forEncoding: 'utf-8'.
toDecode := aCollectionOfIntegers asByteArray.
decoded := codec decode: toDecode.
self assert: decoded size = 1.
^decoded at: 1
]
platform [
<category: 'accessing'>
^GRPlatform current
]
testAsNumber [
<category: 'testing'>
self assert: 2007 asNumber = 2007.
self assert: '2007' asNumber = 2007
]
testAsSeconds [
<category: 'testing'>
| duration |
duration := Duration
days: 1
hours: 0
minutes: 0
seconds: 0.
self assert: duration asSeconds = 86400
]
testBlockContextWithPossibleArguments [
<category: 'testing'>
| block |
block := [:x | 1 + x].
self assert: (block valueWithPossibleArguments: (Array with: 2)) = 3.
block := [false not].
self assert: (block valueWithPossibleArguments: (Array with: 3))
]
testBlockValuableProtocol [
<category: 'testing'>
self assert: [nil] argumentCount isZero.
self assert: [:x | x] argumentCount = 1.
self assert: [:a :b | a + b] argumentCount = 2.
self shouldnt: [[nil] fixCallbackTemps] raise: Error.
self shouldnt: [[:x | x] fixCallbackTemps] raise: Error.
self shouldnt: [[:a :b | a + b] fixCallbackTemps] raise: Error
]
testCharacterAsUnicode [
"test for:
Character >> #asUnicode
^self asInteger"
<category: 'testing'>
self assert: $S asUnicode = 83
]
testCharacterTo [
<category: 'testing'>
| actual expected |
actual := Array
withAll: 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-'.
actual := actual collect: [:each | each greaseInteger].
expected := #(97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 48 49 50 51 52 53 54 55 56 57 95 45).
self assert: actual size = expected size.
actual with: expected do: [:first :second | self assert: first = second]
]
testDateArithmetic [
<category: 'testing'>
| today tomorrow oneDay minusOneDay |
today := DateTime
year: 2008
month: 9
day: 13
hour: 14
minute: 32
second: 5
offset: Duration zero.
tomorrow := DateTime
year: 2008
month: 9
day: 14
hour: 14
minute: 32
second: 5
offset: Duration zero.
oneDay := Duration
days: 1
hours: 0
minutes: 0
seconds: 0.
minusOneDay := Duration
days: -1
hours: 0
minutes: 0
seconds: 0.
self assert: tomorrow - today = oneDay.
self assert: today - tomorrow = minusOneDay.
self assert: today + oneDay = tomorrow.
self assert: tomorrow - oneDay = today.
self assert: tomorrow + minusOneDay = today.
self assert: today - minusOneDay = tomorrow
]
testDaysInMonthForYear [
<category: 'testing'>
(1 to: 12) with: #(31 28 31 30 31 30 31 31 30 31 30 31)
do:
[:month :days |
self
assert: days = (Date daysInMonth: (Date nameOfMonth: month) forYear: 2007)]
]
testDigitValue [
<category: 'testing'>
'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' with: (0 to: 35)
do: [:each :expected | self assert: each digitValue = expected]
]
testEmptyOrNil [
<category: 'testing'>
self assert: '' isEmptyOrNil.
self assert: nil isEmptyOrNil.
self assert: Array new isEmptyOrNil.
self deny: 'Timberwolf' isEmptyOrNil
]
testFixCallbackTemps [
"Make sure that #fixCallbackTemps is properly understood by block-contexts. Make sure that this is either a nop for Smalltalks with true block closures, or it properly fixes the context otherwise."
<category: 'testing'>
| array blocks values |
array := #(1 2 3).
blocks := array collect: [:each | [each] fixCallbackTemps].
values := blocks collect: [:each | each value].
self assert: values = array
]
testGreaseIntegerOnCharacter [
"ASCII (1 byte)"
<category: 'testing'>
| oWithStroke euro manna |
self assert: $a greaseInteger = 97.
self assert: $A greaseInteger = 65.
"Latin-1 (2 byte)"
oWithStroke := self decodeUtf8Character: #(195 152).
self assert: oWithStroke greaseInteger = 216.
"BMP (3 byte)"
euro := self decodeUtf8Character: #(226 130 172).
self assert: euro greaseInteger = 8364.
"SMP (4 byte)"
manna := self decodeUtf8Character: #(240 144 140 188).
self assert: manna greaseInteger = 66364
]
testGreaseIntegerOnNumber [
<category: 'testing'>
self assert: 2007 greaseInteger = 2007.
self assert: 2007.0 greaseInteger = 2007.
self assert: 2007.1 greaseInteger = 2007.
self assert: 2007.9 greaseInteger = 2007
]
testGreaseIntegerOnString [
<category: 'testing'>
self assert: '' greaseInteger isNil.
self assert: 'a' greaseInteger isNil.
self assert: ' 1' greaseInteger isNil.
self assert: 'a1' greaseInteger isNil.
self assert: '-' greaseInteger isNil.
self assert: '-a' greaseInteger isNil.
self assert: '0' greaseInteger = 0.
self assert: '12' greaseInteger = 12.
self assert: '123' greaseInteger = 123.
self assert: '123456789' greaseInteger = 123456789.
self assert: '-0' greaseInteger = 0.
self assert: '-12' greaseInteger = -12.
self assert: '-123.4' greaseInteger = -123.
self assert: '-123456789' greaseInteger = -123456789
]
testGreaseString [
<category: 'testing'>
self assert: 'Timberwolf' greaseString = 'Timberwolf'.
self assert: #DireWolf greaseString = 'DireWolf'.
self assert: true greaseString = 'true'.
self assert: 666 greaseString = '666'.
self assert: $A greaseString = 'A'.
self assert: nil greaseString = 'nil'.
[1 / 0] on: ZeroDivide
do: [:error | self assert: error greaseString isString].
self assert: 15.25 greaseString = '15.25'.
self assert: nil greaseString isString.
self assert: (4 @ 2) greaseString = '4@2'.
"#seasideString for a byte array should not do any decoding
this is in place to catch encoding errors early"
self assert: #(101 97) asByteArray greaseString ~= 'ea'.
self assert: #(101 97) asByteArray greaseString isString.
self assert: Object new greaseString isString
]
testIfNil [
<category: 'testing'>
self assert: (nil ifNil: [1]) = 1.
self assert: (1 ifNil: [2]) = 1
]
testIfTrueIfFalse [
<category: 'testing'>
self assert: (false ifFalse: [#false]) = #false.
self assert: (false ifTrue: [#true]) isNil.
self assert: (true ifTrue: [#true]) = #true.
self assert: (true ifFalse: [#false]) isNil.
self assert: (true ifTrue: [#true] ifFalse: [#false]) = #true.
self assert: (false ifTrue: [#true] ifFalse: [#false]) = #false.
self assert: (true ifFalse: [#false] ifTrue: [#true]) = #true.
self assert: (false ifFalse: [#false] ifTrue: [#true]) = #false
]
testIsCharacter [
<category: 'testing'>
self deny: 7 isCharacter.
self assert: $7 isCharacter
]
testIsCollection [
<category: 'testing'>
self deny: Object new isCollection
]
testIsKeyword [
<category: 'testing'>
self deny: #isKeyword isKeyword.
self deny: #+ isKeyword.
self assert: #isKeyword: isKeyword.
self assert: #isKeyword:isKeyword: isKeyword
]
testIsUnary [
<category: 'testing'>
self assert: #isUnary isUnary.
self deny: #+ isUnary.
self deny: #isUnary: isUnary.
self deny: #isUnary:isUnary: isUnary
]
testLabel [
<category: 'testing'>
self assert: (self platform label isKindOf: String).
self deny: self platform label isEmpty
]
testNumArgs [
<category: 'testing'>
self assert: #not numArgs isZero.
self assert: #+ numArgs = 1.
self assert: #and: numArgs = 1.
self assert: #value:value: numArgs = 2
]
testPrintStringLimitedTo [
<category: 'testing'>
| longString shortString |
longString := String
streamContents: [:stream | 1 to: 1000 do: [:i | stream nextPutAll: i printString]].
"Squeak implementation adds 9 characters to limited string and VA Smalltalk adds 10, so we can't do an exact count."
self assert: longString printString size > 65.
shortString := longString printStringLimitedTo: 50.
self assert: shortString size < 65
]
testSeconds [
<category: 'testing'>
self assert: Time now seconds isInteger.
self deny: Time now seconds isFraction
]
testSecureHashFor [
"Make sure the platform class provides a #secureHashFor: method. The
method is called by Seaside when hashing passwords. The Squeak
implementation returns a SHA-1 hash but another equivalent hash method
could also be used."
<category: 'testing'>
| a b |
a := self platform secureHashFor: 'foobar'.
b := self platform secureHashFor: 'foobar'.
self assert: a = b
]
testStackDepth [
<category: 'testing'>
| stackDepth someBlock |
stackDepth := self platform stackDepth.
self assert: stackDepth isInteger.
self assert: stackDepth > 0.
someBlock := [self assert: self platform stackDepth > stackDepth].
someBlock value.
self assert: stackDepth = self platform stackDepth
]
testSymbolAsMutator [
"test for:
Symbol >> #asMutator
^ (self copyWith: $:) asSymbol"
<category: 'testing'>
self assert: #name asMutator = #name:
]
testTotalSeconds [
"Answer the total seconds since the Squeak epoch: 1 January 1901."
<category: 'testing'>
| seconds |
seconds := Time totalSeconds.
self assert: seconds isInteger.
self assert: seconds > 3421645167
]
testVersion [
<category: 'testing'>
self assert: (self platform version isKindOf: GRVersion).
self assert: (self platform versionString isKindOf: String).
self deny: self platform versionString isEmpty
]
testRandomGenerator [
<category: 'testing-streams'>
| generator collection |
generator := self platform newRandom.
self should: [generator nextInt: 0] raise: Error.
self assert: (generator nextInt: 1) = 1.
collection := (1 to: 200) collect: [:ea | generator nextInt: 2].
self assert: (collection includes: 1).
self assert: (collection includes: 2).
self assert: collection asSet size = 2.
collection := 1 to: 5.
self assert: (collection includes: (generator randomFrom: collection)).
collection := -1.5 to: 3.5.
self assert: (collection includes: (generator randomFrom: collection)).
collection := #(1 2 3 4 5).
self assert: (collection includes: (generator randomFrom: collection)).
collection := #(1 2 3 4 5) asSet.
self assert: (collection includes: (generator randomFrom: collection))
]
testReadStreamAtEnd [
"ANSI 5.9.2.1"
<category: 'testing-streams'>
| stream |
stream := '' readStream.
self assert: stream atEnd.
stream := 'a' readStream.
self deny: stream atEnd
]
testReadStreamContents [
"ANSI 5.9.3.1"
<category: 'testing-streams'>
| stream |
stream := 'abc' readStream.
self assert: stream contents = 'abc'.
stream next: 2.
self assert: stream contents = 'abc'
]
testReadStreamNegativeSkip [
"ANSI does not mention negative values being used with #skip: but we
believe they work consistently. If not, we need to update our coding
conventions to make sure we never do this."
<category: 'testing-streams'>
| stream position |
stream := 'abcd' readStream.
stream
next;
next.
position := stream position.
self assert: stream peek = $c.
stream skip: -1.
self assert: stream position = (position - 1).
self assert: stream peek = $b
]
testReadStreamNext [
"ANSI 5.9.2.3"
<category: 'testing-streams'>
| stream |
stream := 'abcd' readStream.
self assert: stream next = $a.
self assert: (stream next: 0) = ''.
self assert: (stream next: 1) = 'b'.
self assert: (stream next: 2) = 'cd'
]
testReadStreamPeek [
"ANSI 5.9.2.7"
<category: 'testing-streams'>
| stream |
stream := 'abcd' readStream.
self assert: stream peek = $a.
stream := '' readStream.
self assert: stream peek isNil
]
testReadStreamPosition [
"ANSI 5.9.1.4 and 5.9.1.5"
<category: 'testing-streams'>
| stream |
stream := 'abc' readStream.
self assert: stream position = 0.
stream next.
self assert: stream position = 1.
stream next.
self assert: stream position = 2.
stream next.
self assert: stream position = 3.
stream position: 1.
self assert: stream position = 1.
self assert: stream next = $b.
stream position: 0.
self assert: stream position = 0.
self assert: stream next = $a.
stream position: 3.
self assert: stream atEnd
]
testReadStreamReset [
"ANSI 5.9.1.6"
<category: 'testing-streams'>
| stream |
stream := 'abc' readStream.
stream next: 2.
stream reset.
self assert: stream next = $a
]
testReadStreamSkip [
"ANSI 5.9.2.9"
<category: 'testing-streams'>
| stream |
stream := 'abcd' readStream.
self assert: (stream
skip: 2;
peek) = $c
]
testReadStreamUpTo [
"ANSI 5.9.2.11"
<category: 'testing-streams'>
| stream |
stream := 'abcd' readStream.
self assert: (stream upTo: $c) = 'ab'.
self assert: stream next = $d.
stream := 'abcd' readStream.
self assert: (stream upTo: $x) = 'abcd'.
self assert: stream atEnd
]
testReadStreamUpToEnd [
"Not defined by ANSI."
<category: 'testing-streams'>
| stream |
stream := 'abcd' readStream.
self assert: stream upToEnd = 'abcd'.
self assert: stream atEnd.
self assert: stream upToEnd = ''.
self assert: stream atEnd.
stream := 'abcd' readStream.
stream upTo: $b.
self assert: stream upToEnd = 'cd'.
self assert: stream atEnd
]
testReadWriteStreamAtEnd [
"ANSI 5.9.2.1"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
self assert: stream atEnd.
stream
nextPut: $a;
reset.
self deny: stream atEnd
]
testReadWriteStreamContents [
"ANSI 5.9.3.1"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abc';
reset.
self assert: stream contents = 'abc'.
stream next: 2.
self assert: stream contents = 'abc'.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abc' asByteArray;
reset.
self assert: stream contents = 'abc' asByteArray.
stream next: 2.
self assert: stream contents = 'abc' asByteArray
]
testReadWriteStreamNegativeSkip [
"ANSI does not mention negative values being used with #skip: but we
believe they work consistently. If not, we need to update our coding
conventions to make sure we never do this."
<category: 'testing-streams'>
| stream position |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
stream
next;
next.
position := stream position.
self assert: stream peek = $c.
stream skip: -1.
self assert: stream position = (position - 1).
self assert: stream peek = $b.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
stream
next;
next.
position := stream position.
self assert: stream peek = 99.
stream skip: -1.
self assert: stream position = (position - 1).
self assert: stream peek = 98
]
testReadWriteStreamNext [
"ANSI 5.9.2.3"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: stream next = $a.
self assert: (stream next: 0) = ''.
self assert: (stream next: 1) = 'b'.
self assert: (stream next: 2) = 'cd'.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: stream next = 97.
self assert: (stream next: 0) = '' asByteArray.
self assert: (stream next: 1) = 'b' asByteArray.
self assert: (stream next: 2) = 'cd' asByteArray
]
testReadWriteStreamNextPut [
"ANSI 5.9.4.3"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream nextPut: $a.
self assert: stream contents = 'a'.
stream := GRPlatform current readWriteByteStream.
stream nextPut: 97.
self assert: stream contents = 'a' asByteArray
]
testReadWriteStreamNextPutAll [
"ANSI 5.9.4.4"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream nextPutAll: 'abc'.
self assert: stream contents = 'abc'.
stream := GRPlatform current readWriteCharacterStream.
stream nextPutAll: #($a $b $c).
self assert: stream contents = 'abc'.
stream := GRPlatform current readWriteByteStream.
stream nextPutAll: #(97 98 99) asByteArray.
self assert: stream contents = 'abc' asByteArray
]
testReadWriteStreamPeek [
"ANSI 5.9.2.7"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
self assert: stream peek isNil.
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: stream peek = $a.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: stream peek = 97
]
testReadWriteStreamPosition [
"ANSI 5.9.1.4 and 5.9.1.5"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abc';
reset.
self assert: stream position = 0.
stream next.
self assert: stream position = 1.
stream next.
self assert: stream position = 2.
stream next.
self assert: stream position = 3.
stream position: 1.
self assert: stream position = 1.
self assert: stream next = $b.
stream position: 0.
self assert: stream position = 0.
self assert: stream next = $a.
stream position: 3.
self assert: stream atEnd.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abc' asByteArray;
reset.
self assert: stream position = 0.
stream next.
self assert: stream position = 1.
stream next.
self assert: stream position = 2.
stream next.
self assert: stream position = 3.
stream position: 1.
self assert: stream position = 1.
self assert: stream next = 98.
stream position: 0.
self assert: stream position = 0.
self assert: stream next = 97.
stream position: 3.
self assert: stream atEnd
]
testReadWriteStreamReset [
"ANSI 5.9.1.6"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abc';
reset.
stream next: 2.
stream reset.
self assert: stream next = $a.
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abc';
reset.
stream nextPutAll: 'def'.
self assert: stream contents = 'def'.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abc' asByteArray;
reset.
stream next: 2.
stream reset.
self assert: stream next = 97
]
testReadWriteStreamSkip [
"ANSI 5.9.2.9"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: (stream
skip: 2;
peek) = $c.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: (stream
skip: 2;
peek) = 99
]
testReadWriteStreamTab [
"ANSI 5.9.4.6"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream tab.
self assert: stream contents first = Character tab
]
testReadWriteStreamUpTo [
"ANSI 5.9.2.11"
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: (stream upTo: $c) = 'ab'.
self assert: stream next = $d.
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: (stream upTo: $x) = 'abcd'.
self assert: stream atEnd.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: (stream upTo: 99) = #(97 98) asByteArray.
self assert: stream next = 100.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: (stream upTo: 120) = #(97 98 99 100) asByteArray.
self assert: stream atEnd
]
testReadWriteStreamUpToEnd [
"Not defined by ANSI."
<category: 'testing-streams'>
| stream |
stream := GRPlatform current readWriteCharacterStream.
stream
nextPutAll: 'abcd';
reset.
self assert: stream upToEnd = 'abcd'.
self assert: stream atEnd.
self assert: stream upToEnd = ''.
self assert: stream atEnd.
stream reset.
stream upTo: $b.
self assert: stream upToEnd = 'cd'.
self assert: stream atEnd.
stream := GRPlatform current readWriteByteStream.
stream
nextPutAll: 'abcd' asByteArray;
reset.
self assert: stream upToEnd = #(97 98 99 100) asByteArray.
self assert: stream atEnd.
self assert: stream upToEnd = #() asByteArray.
self assert: stream atEnd.
stream reset.
stream upTo: 98.
self assert: stream upToEnd = #(99 100) asByteArray.
self assert: stream atEnd
]
testWriteStreamContents [
"ANSI 5.9.3.1"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream nextPutAll: 'abc'.
self assert: stream contents = 'abc'.
stream nextPutAll: 'def'.
self assert: stream contents = 'abcdef'
]
testWriteStreamCrLf [
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream crlf.
self assert: stream contents first codePoint = 13.
self assert: stream contents second codePoint = 10
]
testWriteStreamNextPut [
"ANSI 5.9.4.3"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream nextPut: $a.
self assert: stream contents = 'a'
]
testWriteStreamNextPutAll [
"ANSI 5.9.4.4"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream nextPutAll: 'abc'.
self assert: stream contents = 'abc'.
stream := WriteStream on: String new.
stream nextPutAll: #($a $b $c).
self assert: stream contents = 'abc'
]
testWriteStreamReset [
"ANSI 5.9.1.6"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream nextPutAll: 'abc'.
stream reset.
stream nextPutAll: 'def'.
self assert: stream contents = 'def'
]
testWriteStreamSpace [
"ANSI 5.9.4.5"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream space.
self assert: stream contents first = Character space
]
testWriteStreamTab [
"ANSI 5.9.4.6"
<category: 'testing-streams'>
| stream |
stream := WriteStream on: String new.
stream tab.
self assert: stream contents first = Character tab
]
testReadStreamSeasideUpToAll [
<category: 'testing-streams-seaside'>
| stream string1 string2 |
stream := 'abc12def' readStream.
string1 := stream greaseUpToAll: '12'.
string2 := stream greaseUpToAll: '12'.
self assert: string1 = 'abc'.
self assert: string2 = 'def'.
self assert: stream atEnd
]
testShutDownList [
"A smoke test: checks if the test-class can be added and removed to the shutdown list."
<category: 'testing-image'>
[self platform addToShutDownList: self class]
ensure: [self platform removeFromShutDownList: self class]
]
testStartUpList [
"A smoke test: checks if the test-class can be added and removed to the startup list."
<category: 'testing-image'>
[self platform addToStartUpList: self class]
ensure: [self platform removeFromStartUpList: self class]
]
testTerminate [
<category: 'testing-processes'>
| ensureRun ifCurtailedRun semaphore1 semaphore2 semaphore3 semaphore4 process |
ensureRun := false.
ifCurtailedRun := false.
semaphore1 := self platform semaphoreClass new.
semaphore2 := self platform semaphoreClass new.
semaphore3 := self platform semaphoreClass new.
semaphore4 := self platform semaphoreClass new.
process := [[[semaphore1 signal.
semaphore2 wait] ensure:
[ensureRun := true.
semaphore3 signal]]
ifCurtailed:
[ifCurtailedRun := true.
semaphore4 signal]]
newProcess.
self deny: (self platform isProcessTerminated: process).
process resume.
semaphore1 wait.
self deny: (self platform isProcessTerminated: process).
self platform terminateProcess: process.
semaphore3 wait.
self assert: ensureRun.
semaphore4 wait.
self assert: ifCurtailedRun.
self assert: (self platform isProcessTerminated: process)
]
]

805
grease/Tests/Core/GRPrinterTest.st Normal file
View File

@ -0,0 +1,805 @@
TestCase subclass: GRPrinterTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
GRPrinterTest class >> packageNamesUnderTest [
<category: 'accessing'>
^#('Grease-Core')
]
testComposedPrinter [
<category: 'testing'>
| converter |
converter := GRSequentialPrinter new , 'CHF ' , GRNumberPrinter new.
self assert: (converter print: 1234) = 'CHF 1234'.
self assert: (converter print: -1234) = 'CHF 1234'.
converter := GRSignPrinter new , GRNumberPrinter new , '%'.
self assert: (converter print: 1234) = '1234%'.
self assert: (converter print: -1234) = '-1234%'
]
testFileSizePrinterBinary [
<category: 'testing'>
| converter |
converter := GRPrinter binaryFileSize.
self assert: (converter print: 1) = '1 byte'.
self assert: (converter print: 2) = '2 bytes'.
self assert: (converter print: 30) = '30 bytes'.
self assert: (converter print: 500) = '500 bytes'.
self assert: (converter print: 6000) = '5.9 KiB'.
self assert: (converter print: 70000) = '68.4 KiB'.
self assert: (converter print: 800000) = '781.3 KiB'.
self assert: (converter print: 9000000) = '8.6 MiB'.
self assert: (converter print: 10000000) = '9.5 MiB'.
self assert: (converter print: 200000000) = '190.7 MiB'.
self assert: (converter print: 3000000000) = '2.8 GiB'.
self assert: (converter print: 40000000000) = '37.3 GiB'
]
testFileSizePrinterDecimal [
<category: 'testing'>
| converter |
converter := GRPrinter decimalFileSize.
self assert: (converter print: 1) = '1 byte'.
self assert: (converter print: 2) = '2 bytes'.
self assert: (converter print: 30) = '30 bytes'.
self assert: (converter print: 500) = '500 bytes'.
self assert: (converter print: 6000) = '6.0 kB'.
self assert: (converter print: 70000) = '70.0 kB'.
self assert: (converter print: 800000) = '800.0 kB'.
self assert: (converter print: 9000000) = '9.0 MB'.
self assert: (converter print: 10000000) = '10.0 MB'.
self assert: (converter print: 200000000) = '200.0 MB'.
self assert: (converter print: 3000000000) = '3.0 GB'.
self assert: (converter print: 40000000000) = '40.0 GB'
]
testFloatPrinter [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new precision: 2.
self assert: (converter print: 1.009) = '1.01'.
self assert: (converter print: 1.01) = '1.01'.
self assert: (converter print: 1.019) = '1.02'.
self assert: (converter print: 1.25) = '1.25'.
self assert: (converter print: 1.254) = '1.25'.
self assert: (converter print: 1.256) = '1.26'.
self assert: (converter print: 1.009) = '1.01'.
self assert: (converter print: 0.9) = '0.90'.
self assert: (converter print: 0.99) = '0.99'.
self assert: (converter print: 0.999) = '1.00'.
self assert: (converter print: 0.9999) = '1.00'.
self assert: (converter print: -0.9) = '0.90'.
self assert: (converter print: -0.99) = '0.99'.
self assert: (converter print: -0.999) = '1.00'.
self assert: (converter print: -0.9999) = '1.00'
]
testFloatPrinterInfinity [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter print: Float infinity) = 'Infinite'.
self assert: (converter print: Float infinity negated) = 'Infinite'.
converter infinite: 'very huge'.
self assert: (converter print: Float infinity) = 'very huge'.
self assert: (converter print: Float infinity negated) = 'very huge'
]
testFloatPrinterNaN [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter print: Float nan) = 'NaN'.
converter nan: 'Not A Number'.
self assert: (converter print: Float nan) = 'Not A Number'
]
testFloatPrinterPadding [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new.
converter digits: 3.
self assert: (converter print: 1) = ' 1'.
self assert: (converter print: 12) = ' 12'.
self assert: (converter print: 123) = '123'.
self assert: (converter print: 1234) = '1234'.
converter padding: $*.
self assert: (converter print: 1) = '**1'.
self assert: (converter print: 12) = '*12'.
self assert: (converter print: 123) = '123'.
self assert: (converter print: 1234) = '1234'
]
testFloatPrinterSeparator [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new.
converter
precision: 2;
separator: $*.
self assert: (converter print: 12345.0) = '12*345.00'.
self assert: (converter print: 0.6789000000000001) = '0.68'.
converter
precision: 4;
separator: $!.
self assert: (converter print: 12345.0) = '12!345.000!0'.
self assert: (converter print: 0.6789000000000001) = '0.678!9'
]
testIntegerPrinter [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter print: 1234) = '1234'.
self assert: (converter print: -1234) = '1234'.
converter separator: $..
self assert: (converter print: 1234) = '1.234'.
self assert: (converter print: 1234567) = '1.234.567'.
converter
base: 16;
separator: nil.
self assert: (converter print: 1234) = '4d2'.
self assert: (converter print: 123123) = '1e0f3'.
converter uppercase.
self assert: (converter print: 1234) = '4D2'.
self assert: (converter print: 123123) = '1E0F3'
]
testOrdinalizePrinter [
<category: 'testing'>
| converter |
converter := GRNumberPrinter new , GROrdinalizePrinter new.
self assert: (converter print: 1) = '1st'.
self assert: (converter print: 2) = '2nd'.
self assert: (converter print: 3) = '3rd'.
self assert: (converter print: 4) = '4th'.
self assert: (converter print: 10) = '10th'.
self assert: (converter print: 111) = '111th'.
self assert: (converter print: 212) = '212th'.
self assert: (converter print: 313) = '313th'.
self assert: (converter print: 414) = '414th'.
self assert: (converter print: 20) = '20th'.
self assert: (converter print: 121) = '121st'.
self assert: (converter print: 222) = '222nd'.
self assert: (converter print: 323) = '323rd'.
self assert: (converter print: 424) = '424th'
]
testSignPrinter [
<category: 'testing'>
| converter |
converter := GRSignPrinter new.
converter
negativePrinter: $-;
positivePrinter: $+.
self assert: (converter print: 12) = '+'.
self assert: (converter print: -12) = '-'
]
testStringPrinter [
<category: 'testing'>
| converter |
converter := GRStringPrinter new.
self assert: (converter print: 123) = '123'.
self assert: (converter print: 'foo') = 'foo'.
self assert: (converter print: true) = 'true'
]
testStringPrinterLength [
<category: 'testing'>
| converter |
converter := GRStringPrinter new.
self assert: (converter print: 'foo') = 'foo'.
converter length: 3.
self assert: (converter print: 'foo') = 'foo'.
converter length: 1.
self assert: (converter print: 'foo') = 'f'
]
testStringPrinterPad [
<category: 'testing'>
| converter |
converter := GRStringPrinter new.
converter
character: $*;
length: 5.
converter padLeft.
self assert: (converter print: 'foo') = '**foo'.
converter padRight.
self assert: (converter print: 'foo') = 'foo**'.
converter padCenter.
self assert: (converter print: 'foo') = '*foo*'
]
testStringPrinterTrim [
<category: 'testing'>
| converter |
converter := GRStringPrinter new.
self assert: (converter print: ' foo ') = ' foo '.
converter trimLeft.
self assert: (converter print: ' foo ') = 'foo '.
converter trimRight.
self assert: (converter print: ' foo ') = ' foo'.
converter trimBoth.
self assert: (converter print: ' foo ') = 'foo'
]
testCookieTimestamp [
<category: 'testing-timestamp'>
| printer date |
printer := GRPrinter cookieTimestamp.
date := DateTime
year: 2008
month: 8
day: 1
hour: 9
minute: 4
second: 4
offset: (Duration
days: 0
hours: 0
minutes: 0
seconds: 0).
self assert: (printer print: date) = 'Fri, 01-Aug-2008 09:04:04 GMT'
]
testHttp [
<category: 'testing-timestamp'>
| printer date offsetHour |
offsetHour := 2.
printer := GRPrinter httpDate.
date := DateTime
year: 1994
month: 11
day: 6
hour: 8 + offsetHour
minute: 49
second: 37
offset: (Duration
days: 0
hours: offsetHour
minutes: 0
seconds: 0).
self assert: (printer print: date) = 'Sun, 06 Nov 1994 08:49:37 GMT'
]
testIsoDate [
<category: 'testing-timestamp'>
| printer |
printer := GRPrinter isoDate.
self
assert: (printer print: (Date
year: 1980
month: 6
day: 11))
= '1980-06-11'.
self
assert: (printer print: (Date
year: 2003
month: 12
day: 1))
= '2003-12-01'.
self
assert: (printer print: (Date
year: 800
month: 12
day: 24))
= '0800-12-24'
]
testIsoTime [
<category: 'testing-timestamp'>
| printer |
printer := GRPrinter isoTime.
self
assert: (printer print: (Time
hour: 0
minute: 0
second: 0))
= '00:00:00'.
self
assert: (printer print: (Time
hour: 1
minute: 2
second: 3))
= '01:02:03'.
self
assert: (printer print: (Time
hour: 12
minute: 23
second: 34))
= '12:23:34'
]
testRfc822 [
<category: 'testing-timestamp'>
| printer date |
printer := GRPrinter rfc822.
date := DateTime
year: 2008
month: 8
day: 1
hour: 9
minute: 4
second: 4
offset: (Duration
days: 0
hours: -2
minutes: 0
seconds: 0).
self assert: (printer print: date) = 'Fri, 01 Aug 2008 09:04:04 -0200'.
date := DateTime
year: 2008
month: 8
day: 31
hour: 19
minute: 41
second: 46
offset: (Duration
days: 0
hours: 0
minutes: 30
seconds: 0).
self assert: (printer print: date) = 'Sun, 31 Aug 2008 19:41:46 +0030'
]
testRfc822WithTimeZone [
<category: 'testing-timestamp'>
| printer date |
printer := GRPrinter rfc822WithTimeZone: 'GMT'.
date := DateTime
year: 2008
month: 8
day: 1
hour: 9
minute: 4
second: 4
offset: (Duration
days: 0
hours: 0
minutes: 0
seconds: 0).
self assert: (printer print: date) = 'Fri, 01 Aug 2008 09:04:04 GMT'
]
testDigitsOf [
<category: 'testing-utilites'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter digitsOf: 0.0 base: 10) = '0'.
self assert: (converter digitsOf: 1.0 base: 10) = '1'.
self assert: (converter digitsOf: -1.0 base: 10) = '1'.
self assert: (converter digitsOf: -1234567890 base: 10) = '1234567890'.
self assert: (converter digitsOf: 1234567890 base: 10) = '1234567890'.
self assert: (converter digitsOf: -9876543210 base: 10) = '9876543210'.
self assert: (converter digitsOf: 9876543210 base: 10) = '9876543210'
]
testDigitsOfBase [
<category: 'testing-utilites'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter digitsOf: 1234 base: 2) = '10011010010'.
self assert: (converter digitsOf: 1234 base: 3) = '1200201'.
self assert: (converter digitsOf: 1234 base: 4) = '103102'.
self assert: (converter digitsOf: 1234 base: 5) = '14414'.
self assert: (converter digitsOf: 1234 base: 6) = '5414'.
self assert: (converter digitsOf: 1234 base: 7) = '3412'.
self assert: (converter digitsOf: 1234 base: 8) = '2322'.
self assert: (converter digitsOf: 1234 base: 9) = '1621'.
self assert: (converter digitsOf: 1234 base: 10) = '1234'.
self assert: (converter digitsOf: 1234 base: 11) = 'a22'.
self assert: (converter digitsOf: 1234 base: 12) = '86a'.
self assert: (converter digitsOf: 1234 base: 13) = '73c'.
self assert: (converter digitsOf: 1234 base: 14) = '642'.
self assert: (converter digitsOf: 1234 base: 15) = '574'.
self assert: (converter digitsOf: 1234 base: 16) = '4d2'
]
testPadCenter [
<category: 'testing-utilites'>
| converter |
converter := GRPrinter new.
self
assert: (converter
pad: ''
center: $*
to: 3) = '***'.
self
assert: (converter
pad: '1'
center: $*
to: 3) = '*1*'.
self
assert: (converter
pad: '12'
center: $*
to: 3) = '12*'.
self
assert: (converter
pad: '123'
center: $*
to: 3) = '123'.
self
assert: (converter
pad: '1234'
center: $*
to: 3) = '1234'
]
testPadLeft [
<category: 'testing-utilites'>
| converter |
converter := GRPrinter new.
self assert: (converter
pad: ''
left: $*
to: 3) = '***'.
self
assert: (converter
pad: '1'
left: $*
to: 3) = '**1'.
self
assert: (converter
pad: '12'
left: $*
to: 3) = '*12'.
self
assert: (converter
pad: '123'
left: $*
to: 3) = '123'.
self
assert: (converter
pad: '1234'
left: $*
to: 3) = '1234'
]
testPadRight [
<category: 'testing-utilites'>
| converter |
converter := GRPrinter new.
self
assert: (converter
pad: ''
right: $*
to: 3) = '***'.
self
assert: (converter
pad: '1'
right: $*
to: 3) = '1**'.
self
assert: (converter
pad: '12'
right: $*
to: 3) = '12*'.
self
assert: (converter
pad: '123'
right: $*
to: 3) = '123'.
self
assert: (converter
pad: '1234'
right: $*
to: 3) = '1234'
]
testSeparateLeft [
<category: 'testing-utilites'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter separate: '' left: $*) = ''.
self assert: (converter separate: '1' left: $*) = '1'.
self assert: (converter separate: '12' left: $*) = '12'.
self assert: (converter separate: '123' left: $*) = '123'.
self assert: (converter separate: '1234' left: $*) = '123*4'.
self assert: (converter separate: '12345' left: $*) = '123*45'.
self assert: (converter separate: '123456' left: $*) = '123*456'.
self assert: (converter separate: '1234567' left: $*) = '123*456*7'.
self assert: (converter separate: '12345678' left: $*) = '123*456*78'.
self assert: (converter separate: '123456789' left: $*) = '123*456*789'
]
testSeparateRight [
<category: 'testing-utilites'>
| converter |
converter := GRNumberPrinter new.
self assert: (converter separate: '' right: $*) = ''.
self assert: (converter separate: '1' right: $*) = '1'.
self assert: (converter separate: '12' right: $*) = '12'.
self assert: (converter separate: '123' right: $*) = '123'.
self assert: (converter separate: '1234' right: $*) = '1*234'.
self assert: (converter separate: '12345' right: $*) = '12*345'.
self assert: (converter separate: '123456' right: $*) = '123*456'.
self assert: (converter separate: '1234567' right: $*) = '1*234*567'.
self assert: (converter separate: '12345678' right: $*) = '12*345*678'.
self assert: (converter separate: '123456789' right: $*) = '123*456*789'
]
testFullMonthName [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter fullMonthName.
self
assert: (printer print: (Date
year: 2000
month: 8
day: 1))
= 'August'.
self
assert: (printer print: (Date
year: 2000
month: 11
day: 1))
= 'November'
]
testFullWeekName [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter fullWeekName.
self
assert: (printer print: (Date
year: 1980
month: 1
day: 1))
= 'Tuesday'.
self
assert: (printer print: (Date
year: 2000
month: 1
day: 1))
= 'Saturday'
]
testPaddedCentury [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter paddedCentury.
self
assert: (printer print: (Date
year: 1980
month: 1
day: 1))
= '80'.
self
assert: (printer print: (Date
year: 2009
month: 1
day: 1))
= '09'
]
testUnpaddedCentury [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter unpaddedCentury.
self
assert: (printer print: (Date
year: 1980
month: 1
day: 1))
= '80'.
self
assert: (printer print: (Date
year: 2009
month: 1
day: 1))
= '9'
]
testUnpaddedDay [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter unpaddedDay.
self
assert: (printer print: (Date
year: 2000
month: 1
day: 4))
= '4'.
self
assert: (printer print: (Date
year: 2000
month: 1
day: 19))
= '19'
]
testUnpaddedMonth [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter unpaddedMonth.
self
assert: (printer print: (Date
year: 2000
month: 8
day: 1))
= '8'.
self
assert: (printer print: (Date
year: 2000
month: 11
day: 1))
= '11'
]
testUnpaddedYear [
<category: 'testing-parts-date'>
| printer |
printer := GRPrinter unpaddedYear.
self
assert: (printer print: (Date
year: 766
month: 1
day: 1))
= '766'.
self
assert: (printer print: (Date
year: 1980
month: 1
day: 1))
= '1980'.
self
assert: (printer print: (Date
year: 2009
month: 1
day: 1))
= '2009'
]
testPaddedHour12 [
<category: 'testing-parts-time'>
| printer |
printer := GRPrinter paddedHour12.
self
assert: (printer print: (Time
hour: 5
minute: 0
second: 0))
= '05'.
self
assert: (printer print: (Time
hour: 10
minute: 0
second: 0))
= '10'.
self
assert: (printer print: (Time
hour: 14
minute: 0
second: 0))
= '02'.
self
assert: (printer print: (Time
hour: 23
minute: 0
second: 0))
= '11'
]
testUnpaddedHour12 [
<category: 'testing-parts-time'>
| printer |
printer := GRPrinter unpaddedHour12.
self
assert: (printer print: (Time
hour: 5
minute: 0
second: 0))
= '5'.
self
assert: (printer print: (Time
hour: 10
minute: 0
second: 0))
= '10'.
self
assert: (printer print: (Time
hour: 14
minute: 0
second: 0))
= '2'.
self
assert: (printer print: (Time
hour: 23
minute: 0
second: 0))
= '11'
]
testUnpaddedHour24 [
<category: 'testing-parts-time'>
| printer |
printer := GRPrinter unpaddedHour24.
self
assert: (printer print: (Time
hour: 5
minute: 0
second: 0))
= '5'.
self
assert: (printer print: (Time
hour: 10
minute: 0
second: 0))
= '10'.
self
assert: (printer print: (Time
hour: 14
minute: 0
second: 0))
= '14'.
self
assert: (printer print: (Time
hour: 23
minute: 0
second: 0))
= '23'
]
testUnpaddedMinute [
<category: 'testing-parts-time'>
| printer |
printer := GRPrinter unpaddedMinute.
self
assert: (printer print: (Time
hour: 0
minute: 5
second: 0))
= '5'.
self
assert: (printer print: (Time
hour: 0
minute: 12
second: 0))
= '12'
]
testUnpaddedSecond [
<category: 'testing-parts-time'>
| printer |
printer := GRPrinter unpaddedSecond.
self
assert: (printer print: (Time
hour: 0
minute: 0
second: 0))
= '0'.
self
assert: (printer print: (Time
hour: 0
minute: 0
second: 9))
= '9'.
self
assert: (printer print: (Time
hour: 0
minute: 0
second: 12))
= '12'
]
testSwissCurrency [
<category: 'testing-currency'>
| printer |
printer := GRPrinter swissCurrency.
self assert: (printer print: 12.34) = 'CHF 12.35'.
self assert: (printer print: -12.39) = 'CHF -12.40'
]
testUsCurrency [
<category: 'testing-currency'>
| printer |
printer := GRPrinter usCurrency.
self assert: (printer print: 12.34) = '$12.34'.
self assert: (printer print: -12.34) = '-$12.34'
]
]

36
grease/Tests/Core/GRSetTest.st Normal file
View File

@ -0,0 +1,36 @@
GRCollectionTest subclass: GRSetTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateValues [
<category: 'configuration'>
^false
]
collectionClass [
<category: 'configuration'>
^Set
]
isExtensible [
<category: 'testing-ansi'>
^true
]
isInitializable [
<category: 'testing-ansi'>
^true
]
isSequenced [
<category: 'testing-ansi'>
^false
]
isSequencedReadable [
<category: 'testing-ansi'>
^false
]
]

321
grease/Tests/Core/GRSmallDictionaryTest.st Normal file
View File

@ -0,0 +1,321 @@
TestCase subclass: GRSmallDictionaryTest [
| collection |
<comment: nil>
<category: 'Grease-Tests-Core'>
allowsDuplicateKeys [
<category: 'configuration'>
^false
]
collectionClass [
<category: 'configuration'>
^GRSmallDictionary
]
isKey: anObject equivalentTo: anotherObject [
<category: 'configuration'>
^anObject = anotherObject
]
newCollection [
<category: 'configuration'>
^self collectionClass new
]
assertAssociations: anOrderedCollection [
<category: 'asserting'>
| associations iterated |
associations := collection associations.
iterated := Array
streamContents: [:stream | collection associationsDo: [:each | stream nextPut: each]].
self assert: associations size = anOrderedCollection size.
self assert: iterated size = anOrderedCollection size.
1 to: anOrderedCollection size
do:
[:index |
self assert: (associations at: index) = (anOrderedCollection at: index).
self assert: (iterated at: index) = (anOrderedCollection at: index)]
]
setUp [
<category: 'running'>
super setUp.
collection := self newCollection
]
testAddAll [
<category: 'tests-accessing'>
| dict result |
dict := (Dictionary new)
at: '1' put: 'foo';
yourself.
result := collection addAll: dict.
self assert: result == dict.
self assertAssociations: (Array with: '1' -> 'foo').
dict := (GROrderedMultiMap new)
at: '1' put: 'foo';
at: '1' add: 'bar';
yourself.
collection := self newCollection.
result := collection addAll: dict.
self assert: result == dict.
self assertAssociations: (self allowsDuplicateKeys
ifFalse: [Array with: '1' -> 'bar']
ifTrue: [Array with: '1' -> 'foo' with: '1' -> 'bar'])
]
testAddAndAssociations [
<category: 'tests-accessing'>
| association |
association := collection add: '1' -> 'foo'.
self assert: association key = '1'.
self assert: association value = 'foo'.
self assertAssociations: (Array with: '1' -> 'foo').
association := collection add: '2' -> 'bar'.
self assert: association key = '2'.
self assert: association value = 'bar'.
self assertAssociations: (Array with: '1' -> 'foo' with: '2' -> 'bar').
association := collection add: '1' -> 'baz'.
self assert: association key = '1'.
self assert: association value = 'baz'.
self assertAssociations: (self allowsDuplicateKeys
ifFalse: [Array with: '1' -> 'baz' with: '2' -> 'bar']
ifTrue:
[Array
with: '1' -> 'foo'
with: '2' -> 'bar'
with: '1' -> 'baz'])
]
testAt [
<category: 'tests-accessing'>
self should: [collection at: '1'] raise: Error.
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
self assert: (collection at: '1')
= (self allowsDuplicateKeys ifTrue: ['foo'] ifFalse: ['bar'])
]
testAtIfAbsent [
<category: 'tests-accessing'>
self assert: (collection at: '1' ifAbsent: ['foo']) = 'foo'.
collection add: '1' -> 'bar'.
collection add: '1' -> 'baz'.
self assert: (collection at: '1' ifAbsent: ['foo'])
= (self allowsDuplicateKeys ifTrue: ['bar'] ifFalse: ['baz'])
]
testAtIfAbsentPut [
<category: 'tests-accessing'>
self assert: (collection at: '1' ifAbsentPut: ['foo']) = 'foo'.
self assertAssociations: (Array with: '1' -> 'foo').
self assert: (collection at: '1' ifAbsentPut: ['bar']) = 'foo'.
self assertAssociations: (Array with: '1' -> 'foo')
]
testAtIfPresent [
<category: 'tests-accessing'>
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
self assert: (collection at: '1' ifPresent: [:v | v , 'baz'])
= (self allowsDuplicateKeys ifTrue: ['foobaz'] ifFalse: ['barbaz']).
self assert: (collection at: '2' ifPresent: [:v | v , 'baz']) isNil
]
testAtPut [
<category: 'tests-accessing'>
collection at: '1' put: 'foo'.
collection at: '2' put: 'bar'.
self assertAssociations: (Array with: '1' -> 'foo' with: '2' -> 'bar').
collection at: '1' put: 'baz'.
self assertAssociations: (Array with: '1' -> 'baz' with: '2' -> 'bar')
]
testRemoveKey [
<category: 'tests-accessing'>
self should: [collection removeKey: '1'] raise: Error.
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
collection add: '2' -> 'baz'.
self assert: (collection removeKey: '1')
= (self allowsDuplicateKeys ifTrue: [#('foo' 'bar')] ifFalse: ['bar']).
self assertAssociations: (Array with: '2' -> 'baz').
self assert: (collection removeKey: '2')
= (self allowsDuplicateKeys ifTrue: [#('baz')] ifFalse: ['baz']).
self assertAssociations: #()
]
testRemoveKeyIfAbsent [
<category: 'tests-accessing'>
self assert: (collection removeKey: '1' ifAbsent: ['absent']) = 'absent'.
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
collection add: '2' -> 'baz'.
self assert: (collection removeKey: '1' ifAbsent: ['absent'])
= (self allowsDuplicateKeys ifTrue: [#('foo' 'bar')] ifFalse: ['bar']).
self assertAssociations: (Array with: '2' -> 'baz').
self assert: (collection removeKey: '2' ifAbsent: ['absent'])
= (self allowsDuplicateKeys ifTrue: [#('baz')] ifFalse: ['baz']).
self assertAssociations: #()
]
testSize [
<category: 'tests-accessing'>
self assert: collection size = 0.
collection add: '1' -> 'foo'.
self assert: collection size = 1.
collection add: '2' -> 'bar'.
self assert: collection size = 2.
collection add: '1' -> 'baz'.
self assert: collection size
= (self allowsDuplicateKeys ifTrue: [3] ifFalse: [2])
]
testCopy [
<category: 'tests'>
| other |
collection
at: 1 put: 'foo';
at: 2 put: 'bar'.
other := collection copy.
collection
at: 1 put: 'zork';
at: 3 put: 'zonk'.
other at: 2 put: 'other'.
self assert: collection size = 3.
self assert: (collection at: 1) = 'zork'.
self assert: (collection at: 2) = 'bar'.
self assert: (collection at: 3) = 'zonk'.
self assert: other size = 2.
self assert: (other at: 1) = 'foo'.
self assert: (other at: 2) = 'other'
]
testGrow [
<category: 'tests'>
1 to: 100
do:
[:i |
collection at: i put: i negated.
self assert: collection size = i.
[:array :factor |
self assert: array size = i.
1 to: i do: [:j | self assert: (array at: j) = (factor * j)]]
value: collection keys value: 1;
value: collection values value: -1]
]
testWithAll [
<category: 'tests'>
| dict |
dict := (Dictionary new)
at: '1' put: 'foo';
yourself.
collection := self collectionClass withAll: dict.
self assertAssociations: (Array with: '1' -> 'foo').
dict := (GROrderedMultiMap new)
at: '1' put: 'foo';
at: '1' add: 'bar';
yourself.
collection := self collectionClass withAll: dict.
self assertAssociations: (self allowsDuplicateKeys
ifFalse: [Array with: '1' -> 'bar']
ifTrue: [Array with: '1' -> 'foo' with: '1' -> 'bar'])
]
testDo [
<category: 'tests-enumerating'>
| result |
result := OrderedCollection new.
collection
at: '1' put: 'foo';
at: '2' put: 'bar'.
collection do: [:each | result add: each].
self assert: result asArray = #('foo' 'bar')
]
testKeys [
<category: 'tests-enumerating'>
collection
add: '1' -> 'foo';
add: '2' -> 'bar';
add: '1' -> 'baz'.
self assert: collection keys
= (self allowsDuplicateKeys ifTrue: [#('1' '2' '1')] ifFalse: [#('1' '2')])
]
testKeysAndValuesDo [
<category: 'tests-enumerating'>
| iterated |
collection keysAndValuesDo: [:key :value | self assert: false].
collection
add: '1' -> 'foo';
add: '2' -> 'bar';
add: '1' -> 'baz'.
iterated := Array streamContents:
[:stream |
collection keysAndValuesDo: [:key :value | stream nextPut: key -> value]].
self
assert: iterated size = (self allowsDuplicateKeys ifTrue: [3] ifFalse: [2]).
self assert: iterated first
= (self allowsDuplicateKeys ifTrue: ['1' -> 'foo'] ifFalse: ['1' -> 'baz']).
self assert: iterated second = ('2' -> 'bar').
self allowsDuplicateKeys
ifTrue: [self assert: iterated third = ('1' -> 'baz')]
]
testKeysDo [
<category: 'tests-enumerating'>
| result |
result := OrderedCollection new.
collection
add: '1' -> 'foo';
add: '2' -> 'bar';
add: '1' -> 'baz'.
collection keysDo: [:each | result add: each].
self assert: result asArray
= (self allowsDuplicateKeys ifTrue: [#('1' '2' '1')] ifFalse: [#('1' '2')])
]
testValues [
<category: 'tests-enumerating'>
collection
add: '1' -> 'foo';
add: '2' -> 'bar';
add: '1' -> 'baz'.
self
assert: collection values = (self allowsDuplicateKeys
ifTrue: [#('foo' 'bar' 'baz')]
ifFalse: [#('baz' 'bar')])
]
testIncludesKey [
<category: 'tests-testing'>
self deny: (collection includesKey: '1').
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
self assert: (collection includesKey: '1')
]
testIsCollection [
<category: 'tests-testing'>
self assert: collection isCollection
]
testIsDictionary [
<category: 'tests-testing'>
self assert: collection isDictionary
]
testIsEmpty [
<category: 'tests-testing'>
self assert: collection isEmpty.
collection add: '1' -> 'foo'.
collection add: '1' -> 'bar'.
self deny: collection isEmpty
]
]

269
grease/Tests/Core/GRStringTest.st Normal file
View File

@ -0,0 +1,269 @@
GRCollectionTest subclass: GRStringTest [
<category: 'Grease-Tests-Core'>
<comment: nil>
allowDuplicateValues [
<category: 'configuration'>
^true
]
arbitraryCollection [
<category: 'configuration'>
^ 'fadbbc' copy "String literals are immutable"
]
collectionClass [
<category: 'configuration'>
^String
]
duplicateElement [
<category: 'configuration'>
^$b
]
excludedElement [
<category: 'configuration'>
^$Q
]
includedElement [
<category: 'configuration'>
^$d
]
isExtensible [
<category: 'testing-ansi'>
^false
]
isInitializable [
<category: 'testing-ansi'>
^true
]
isSequenced [
<category: 'testing-ansi'>
^true
]
isSequencedReadable [
<category: 'testing-ansi'>
^true
]
testAsUppercase [
<category: 'tests'>
self assert: 'abc' asUppercase = 'ABC'.
self assert: 'ABC' asUppercase = 'ABC'
]
testCapitalized [
<category: 'tests'>
self assert: 'capitalized' capitalized = 'Capitalized'.
self assert: 'Capitalized' capitalized = 'Capitalized'.
self assert: 'CAPITALIZED' capitalized = 'CAPITALIZED'.
self assert: #'capitalized' capitalized = #'Capitalized'.
self assert: #'Capitalized' capitalized = #'Capitalized'.
self assert: #'CAPITALIZED' capitalized = #'CAPITALIZED'.
]
"testCapitalizedUmlauts [
<category: 'tests'>
self assert: 'äöü' capitalized = 'Äöü'.
self assert: 'Äöü' capitalized = 'Äöü'.
self assert: 'ÄÖÜ' capitalized = 'ÄÖÜ'.
self assert: #'äöü' capitalized = #'Äöü'.
self assert: #'Äöü' capitalized = #'Äöü'.
self assert: #'ÄÖÜ' capitalized = #'ÄÖÜ'
]"
testCopyAfter [
<category: 'tests'>
self assert: ('de_CH' copyAfter: $_) = 'CH'
]
testCopyAfterLast [
<category: 'tests'>
self assert: ('britney.sex.tape.mkv' copyAfterLast: $.) = 'mkv'.
self assert: ('britney.sex.tape.mkv' copyAfterLast: $$) = ''
]
testCopyUpTo [
<category: 'tests'>
self assert: ('britney.sex.tape.mkv' copyUpTo: $.) = 'britney'.
self assert: ('britney.sex.tape.mkv' copyUpTo: $$) = 'britney.sex.tape.mkv'
]
testCopyUpToLast [
<category: 'tests'>
self assert: ('britney.sex.tape.mkv' copyUpToLast: $.) = 'britney.sex.tape'
]
testIncludesSubString [
<category: 'tests'>
self assert: ('britney.sex.tape.mkv' beginsWith: 'britney').
self deny: ('britney.sex.tape.mkv' beginsWith: 'sex')
]
testSubStrings [
<category: 'tests'>
"#subStrings: is defined by ANSI 5.7.10.15:
Answer an array containing the substrings in the receiver separated by the elements of separators."
| mimeType tokens |
mimeType := 'application/xhtml+xml'.
tokens := mimeType subStrings: '/'.
self assert: tokens size = 2.
self assert: tokens first = 'application'.
self assert: tokens second = 'xhtml+xml'.
"ANSI is a bit unclear on how multiple sequential delimiters should be treated.
Make sure behaviour is consistent for several delimiters in a row (taken from
Squeak's behaviour)"
tokens := 'abc,.def.ghi' subStrings: '.,'.
self assert: tokens size = 3.
self assert: tokens first = 'abc'.
self assert: tokens second = 'def'.
self assert: tokens third = 'ghi'.
]
testExcerpt [
<category: 'tests-excerpt'>
self assert: ('abcde' excerpt: 'c' radius: 0) = '...c...'.
self assert: ('abcde' excerpt: 'c' radius: 1) = '...bcd...'.
self assert: ('abcde' excerpt: 'c' radius: 2) = 'abcde'.
self assert: ('abcde' excerpt: 'c' radius: 3) = 'abcde'.
self assert: ('abcde' excerpt: 'c' radius: 0 ellipsis: 'x') = 'xcx'.
self assert: ('abcde' excerpt: 'c' radius: 1 ellipsis: 'x') = 'xbcdx'.
self assert: ('abcde' excerpt: 'c' radius: 2 ellipsis: 'x') = 'abcde'
]
testExcerptEmpty [
<category: 'tests-excerpt'>
self assert: ('' excerpt: '') isNil.
self assert: ('' excerpt: 'x') isNil.
self assert: ('x' excerpt: '') isNil
]
testExcerptLeft [
<category: 'tests-excerpt'>
self assert: ('abcde' excerpt: 'd' radius: 0 ellipsis: 'x') = 'xdx'.
self assert: ('abcde' excerpt: 'd' radius: 1 ellipsis: 'x') = 'xcde'.
self assert: ('abcde' excerpt: 'd' radius: 2 ellipsis: 'x') = 'xbcde'.
self assert: ('abcde' excerpt: 'd' radius: 3 ellipsis: 'x') = 'abcde'
]
testExcerptRight [
<category: 'tests-excerpt'>
self assert: ('abcde' excerpt: 'b' radius: 0 ellipsis: 'x') = 'xbx'.
self assert: ('abcde' excerpt: 'b' radius: 1 ellipsis: 'x') = 'abcx'.
self assert: ('abcde' excerpt: 'b' radius: 2 ellipsis: 'x') = 'abcdx'.
self assert: ('abcde' excerpt: 'b' radius: 3 ellipsis: 'x') = 'abcde'
]
testInflectorAssimilated [
<category: 'tests-pluralize'>
self assert: 'vertice' pluralize = 'vertices'.
self assert: 'index' pluralize = 'indices'
]
testInflectorCommonSuffixes [
<category: 'tests-pluralize'>
self assert: 'mouse' pluralize = 'mice'.
self assert: 'synopse' pluralize = 'synopses'.
self assert: 'man' pluralize = 'men'
]
testInflectorFfffSuffixes [
<category: 'tests-pluralize'>
self assert: 'life' pluralize = 'lives'.
self assert: 'wolf' pluralize = 'wolves'
]
testInflectorIrregular [
<category: 'tests-pluralize'>
self assert: 'genie' pluralize = 'genies'.
self assert: 'ox' pluralize = 'oxen'.
self assert: 'cow' pluralize = 'kine'.
self assert: 'child' pluralize = 'children'.
self assert: 'woman' pluralize = 'women'
]
testInflectorNotInflecting [
<category: 'tests-pluralize'>
self assert: 'fish' pluralize = 'fish'.
self assert: 'travois' pluralize = 'travois'.
self assert: 'chassis' pluralize = 'chassis'.
self assert: 'nationalities' pluralize = 'nationalities'
]
testInflectorTsssSuffixes [
<category: 'tests-pluralize'>
self assert: 'church' pluralize = 'churches'.
self assert: 'class' pluralize = 'classes'
]
testInflectorYyyySuffixes [
<category: 'tests-pluralize'>
self assert: 'story' pluralize = 'stories'.
self assert: 'lady' pluralize = 'ladies'.
self assert: 'stay' pluralize = 'stays'.
]
testTrimBoth [
<category: 'tests-trim'>
self assert: '' trimBoth = ''.
self assert: ' ' trimBoth = ''.
self assert: ' ' trimBoth = ''.
self assert: 'foo' trimBoth = 'foo'.
self assert: ' foo ' trimBoth = 'foo'.
self assert: ' foo ' trimBoth = 'foo'.
self assert: ((String with: Character cr), ' foo ') trimBoth = 'foo'.
self assert: ('aabbaa' trimBoth: [ :each | each = $a ]) = 'bb'.
self assert: ('bbaabb' trimBoth: [ :each | each = $a ]) = 'bbaabb'
]
testTrimLeft [
<category: 'tests-trim'>
self assert: '' trimLeft = ''.
self assert: ' ' trimLeft = ''.
self assert: ' ' trimLeft = ''.
self assert: 'foo' trimLeft = 'foo'.
self assert: ' foo ' trimLeft = 'foo '.
self assert: ' foo ' trimLeft = 'foo '.
self assert: ('aabbaa' trimLeft: [ :each | each = $a ]) = 'bbaa'.
self assert: ('bbaabb' trimLeft: [ :each | each = $a ]) = 'bbaabb'
]
testTrimRight [
<category: 'tests-trim'>
self assert: '' trimRight = ''.
self assert: ' ' trimRight = ''.
self assert: ' ' trimRight = ''.
self assert: 'foo' trimRight = 'foo'.
self assert: ' foo ' trimRight = ' foo'.
self assert: ' foo ' trimRight = ' foo'.
self assert: ('aabbaa' trimRight: [ :each | each = $a ]) = 'aabb'.
self assert: ('bbaabb' trimRight: [ :each | each = $a ]) = 'bbaabb'
]
testTruncate [
<category: 'tests-truncate'>
self assert: ('abc' truncate) = 'abc'.
self assert: ('abc' truncate: 3) = 'abc'.
self assert: ('abc' truncate: 2) = 'ab...'.
self assert: ('abc' truncate: 1 ellipsis: '') = 'a'.
self assert: ('abc' truncate: 0 ellipsis: 'none') = 'none'
]
testTruncateEmpty [
<category: 'tests-truncate'>
self assert: '' truncate = ''
]
]

76
grease/Tests/Core/GRUtf8CodecTest.st Normal file
View File

@ -0,0 +1,76 @@
TestCase subclass: GRUtf8CodecTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
asString: aCollectionOfIntegers [
<category: 'private'>
^aCollectionOfIntegers asByteArray asString
]
seasideByteArray [
<category: 'private'>
^#(83 101 97 115 105 100 101) asByteArray "Seaside"
]
decodedString [
<category: 'accessing'>
^'Übèrstrîñgé'
]
utf8String [
<category: 'accessing'>
^self asString:
#(195 156 98 195 168 114 115 116 114 195 174 195 177 103 195 169)
]
testCodecUtf8 [
<category: 'testing'>
#('UTF-8' 'utf-8') do:
[:codecName |
| codec |
codec := GRCodec forEncoding: codecName.
self assert: codec name = codecName.
self assert: codec url name = codecName.
self assert: (codec encode: self decodedString) = self utf8String.
self assert: (codec url encode: self decodedString) = self utf8String.
self assert: (codec decode: self utf8String) = self decodedString.
self assert: (codec url decode: self utf8String) = self decodedString]
]
testCodecUtf8Bom [
<category: 'testing'>
#('UTF-8' 'utf-8') do:
[:codecName |
| codec bom |
codec := GRCodec forEncoding: codecName.
bom := self asString: #(239 187 191).
self assert: (codec decode: bom , self utf8String) = self decodedString.
self assert: (codec url decode: bom , self utf8String) = self decodedString]
]
testCodecUtf8ShortestForm [
"Non shortest form characters should be rejected
See Corrigendum #1: UTF-8 Shortest Form http://www.unicode.org/versions/corrigendum1.html"
<category: 'testing'>
#('UTF-8' 'utf-8') do:
[:codecName |
| codec abc |
codec := GRCodec forEncoding: codecName.
abc := self asString: #(193 129 193 130 193 131).
[self
should: [self assert: (codec decode: abc) ~= 'ABC']
raise: Error]]
]
testNext [
<category: 'testing'>
| stream |
stream := (GRCodec forEncoding: 'utf8')
encoderFor: self seasideByteArray readStream.
self assert: stream next = $S.
self assert: (stream next: 1) = 'e'
]
]

183
grease/Tests/Core/GRVersionTest.st Normal file
View File

@ -0,0 +1,183 @@
TestCase subclass: GRVersionTest [
<comment: nil>
<category: 'Grease-Tests-Core'>
assert: aVersionArray equals: bVersionArray [
<category: 'asserting'>
| a b |
a := self buildVersion: aVersionArray.
b := self buildVersion: bVersionArray.
self deny: a < b.
self assert: a <= b.
self deny: b < a.
self assert: b <= a.
self deny: b > a.
self assert: b >= a.
self deny: a > b.
self assert: a >= b.
self assert: a = b
]
assert: aVersionArray sortsBefore: bVersionArray [
<category: 'asserting'>
| a b |
a := self buildVersion: aVersionArray.
b := self buildVersion: bVersionArray.
self assert: a < b.
self assert: a <= b.
self deny: b < a.
self deny: b <= a.
self assert: b > a.
self assert: b >= a.
self deny: a > b.
self deny: a >= b.
self deny: a = b
]
buildVersion: anArray [
<category: 'private'>
^(GRVersion
major: (anArray at: 1 ifAbsent: [nil])
minor: (anArray at: 2 ifAbsent: [nil])
revision: (anArray at: 3 ifAbsent: [nil]))
stage: (anArray at: 4 ifAbsent: [nil])
number: (anArray at: 5 ifAbsent: [nil]);
yourself
]
testComparison [
<category: 'tests'>
self assert: #(1) sortsBefore: #(2).
self assert: #(2) sortsBefore: #(10).
self assert: #(1) sortsBefore: #(1 1).
self assert: #(1 nil nil #alpha) sortsBefore: #(1).
self assert: #(1 nil nil #alpha) sortsBefore: #(1 0).
self assert: #(1 nil nil #alpha) sortsBefore: #(1 0 0).
self assert: #(1 0) sortsBefore: #(2).
self assert: #(1 0) sortsBefore: #(2 0).
self assert: #(1 0) sortsBefore: #(1 1).
self assert: #(1 2) sortsBefore: #(1 10).
self assert: #(1 0 nil #alpha) sortsBefore: #(1 0).
self assert: #(1 0 nil #alpha) sortsBefore: #(1 0 0).
self assert: #(1 0 0) sortsBefore: #(2).
self assert: #(1 0 0) sortsBefore: #(1 1).
self assert: #(1 0 1) sortsBefore: #(1 1).
self assert: #(1 0 1 #alpha) sortsBefore: #(1 1).
self assert: #(1 1 0 #alpha) sortsBefore: #(1 1).
self assert: #(1 1 0 #alpha 2) sortsBefore: #(1 1).
self assert: #(1 1 0 #beta) sortsBefore: #(1 1).
self assert: #(1 1 0 #beta 2) sortsBefore: #(1 1).
self assert: #(1 nil nil #alpha) sortsBefore: #(1 nil nil #alpha 2).
self assert: #(1 nil nil #beta) sortsBefore: #(1 nil nil #beta 2).
self assert: #(1 0 nil #alpha) sortsBefore: #(1 0 nil #alpha 2).
self assert: #(1 0 nil #beta) sortsBefore: #(1 0 nil #beta 2).
self assert: #(1 0 0 #alpha) sortsBefore: #(1 0 0 #alpha 2).
self assert: #(1 0 0 #beta) sortsBefore: #(1 0 0 #beta 2)
]
testConvenience [
<category: 'tests'>
| version |
version := GRVersion
major: 1
minor: 2
revision: 3.
self assert: version stage isNil.
self assert: version stageNumber isNil.
self assert: version isFinal.
self deny: version isAlpha.
self deny: version isBeta.
version beAlpha.
self assert: version stage = #alpha.
self assert: version stageNumber isNil.
self assert: version isAlpha.
self deny: version isBeta.
self deny: version isFinal.
version beBeta.
self assert: version stage = #beta.
self assert: version stageNumber isNil.
self assert: version isBeta.
self deny: version isAlpha.
self deny: version isFinal.
version beAlpha: 1.
self assert: version stage = #alpha.
self assert: version stageNumber = 1.
self assert: version isAlpha.
self deny: version isBeta.
self deny: version isFinal.
version beBeta: 1.
self assert: version stage = #beta.
self assert: version stageNumber = 1.
self assert: version isBeta.
self deny: version isAlpha.
self deny: version isFinal.
version beFinal.
self assert: version stage isNil.
self assert: version stageNumber isNil.
self assert: version isFinal.
self deny: version isAlpha.
self deny: version isBeta
]
testEquality [
<category: 'tests'>
self assert: #(1) equals: #(1).
self assert: #(1) equals: #(1 0).
self assert: #(1) equals: #(1 0 0).
self assert: #(1 0) equals: #(1 0).
self assert: #(1 0) equals: #(1 0 0).
self assert: #(1 0 0) equals: #(1 0 0).
self assert: #(1 0 0 #alpha) equals: #(1 0 0 #alpha 1).
self assert: #(1 0 0 #beta) equals: #(1 0 0 #beta 1)
]
testStringConversion [
<category: 'tests'>
self
assert: (GRVersion
major: 1
minor: 2
revision: 3) greaseString
= '1.2.3'.
self
assert: (GRVersion
major: 11
minor: 12
revision: 13) greaseString
= '11.12.13'.
self assert: (GRVersion major: 1 minor: 2) greaseString = '1.2'.
self
assert: (GRVersion
major: 1
minor: 2
revision: 0) greaseString
= '1.2.0'.
self assert: (GRVersion major: 1) greaseString = '1.0'.
self
assert: (GRVersion
major: 1
minor: 2
revision: 3) beAlpha
greaseString = '1.2.3alpha'.
self
assert: ((GRVersion
major: 1
minor: 2
revision: 3) beAlpha: 1)
greaseString = '1.2.3alpha1'.
self
assert: (GRVersion
major: 1
minor: 2
revision: 3) beBeta
greaseString = '1.2.3beta'.
self
assert: ((GRVersion
major: 1
minor: 2
revision: 3) beBeta: 1)
greaseString = '1.2.3beta1'
]
]

89
grease/Tests/GST/Core/GRGSTPlatformTest.st Normal file
View File

@ -0,0 +1,89 @@
TestCase subclass: GRGSTPlatformTest [
<comment: nil>
<category: 'Grease-Tests-Gst-Core'>
testCompileIntoClassified [
<category: 'tests'>
| source protocol selectors selector |
source := 'aMethod
[^ ''a result'']'.
protocol := 'a-protocol'.
selector := #aMethod.
GRPlatform current
compile: source
into: self class
classified: protocol.
[self assert: (self class selectors includes: selector).
self assert: (self class whichCategoryIncludesSelector: selector) = protocol]
ensure: [self class removeSelector: selector]
]
testConvertToSmalltalkNewlines [
<category: 'tests'>
| expected euro |
expected := 'selector' , (String with: Character cr) , '"comment"'.
self assert: expected
= (GRPlatform current convertToSmalltalkNewlines: expected).
self assert: expected = (GRPlatform current
convertToSmalltalkNewlines: 'selector' , (String with: Character lf)
, '"comment"').
self assert: expected = (GRPlatform current
convertToSmalltalkNewlines: 'selector'
, (String with: Character cr with: Character lf) , '"comment"').
euro := UnicodeString with: (UnicodeCharacter codePoint: 8364).
self assert: (expected asUnicodeString, euro)
= (GRPlatform current convertToSmalltalkNewlines: expected asUnicodeString, euro).
self assert: (GRPlatform current convertToSmalltalkNewlines: nil) isNil
]
testFullName [
<category: 'tests'>
self assert: Object fullName = 'Object'
]
testGreaseIntegerOnCharacter [
<category: 'tests'>
| character |
character := Character codePoint: 19982.
self assert: character greaseInteger = 19982.
character := UnicodeCharacter value: 19982.
self assert: character greaseInteger = 19982.
]
testDirectedMessageValueWithPossibleArguments [
<category: 'tests'>
| send |
send := DirectedMessage receiver: 1 selector: #+.
self assert: (send valueWithPossibleArguments: (Array with: 2)) = 3.
self assert: (send valueWithArguments: (Array with: 2)) = 3.
self assert: (send value: 2) = 3.
send := DirectedMessage receiver: false selector: #not.
self assert: (send valueWithPossibleArguments: (Array with: 3)).
send := DirectedMessage
receiver: 1
selector: #+
arguments: #(2).
self assert: (send valueWithPossibleArguments: (Array with: 4)) = 3.
self assert: send value = 3.
send := DirectedMessage
receiver: Array
selector: #with:with:
arguments: #(1).
self assert: (send valueWithPossibleArguments: (Array with: 2)) size = 2.
send := DirectedMessage receiver: Array selector: #with:with:.
self assert: (send value: 1 value: 2) size = 2.
send := DirectedMessage receiver: 1 selector: #+.
self assert: send argumentCount = 1.
self assert: send arguments size = 0.
self assert: send fixCallbackTemps == send.
send := DirectedMessage
receiver: 1
selector: #+
argument: 2.
self assert: send argumentCount isZero.
self assert: send arguments size = 1.
self assert: send fixCallbackTemps == send
]
]

81
grease/package.st Normal file
View File

@ -0,0 +1,81 @@
Eval [
PackageBuilder new
name: 'Grease';
namespace: 'Grease';
prereq: 'Iconv';
prereq: 'Digest';
prereq: 'SUnit';
testsBelow: 'Tests' matching: '*.st';
url: 'git://github.com/NicolasPetton/Grease.git';
filein: 'Core/GRObject.st';
filein: 'Core/GRPlatform.st';
filein: 'Core/GRPackage.st';
filein: 'Core/GRVersion.st';
filein: 'Core/Exceptions.st';
filein: 'Core/Extensions.st';
filein: 'Core/Collections/GRSmallDictionary.st';
filein: 'Core/Collections/GROrderedMultiMap.st';
filein: 'Core/Text/GRCodec.st';
filein: 'Core/Text/GRNullCodec.st';
filein: 'Core/Text/GRCodecStream.st';
filein: 'Core/Text/GRNullCodecStream.st';
filein: 'Core/Text/GRInflector.st';
filein: 'Core/Text/GRInvalidUtf8Error.st';
filein: 'Core/Text/GRPrinter.st';
filein: 'Core/Text/GRMappedPrinter.st';
filein: 'Core/Text/GRNumberPrinter.st';
filein: 'Core/Text/GROrdinalizePrinter.st';
filein: 'Core/Text/GRPluggablePrinter.st';
filein: 'Core/Text/GRSequentialPrinter.st';
filein: 'Core/Text/GRSignPrinter.st';
filein: 'Core/Text/GRStringPrinter.st';
filein: 'Core/Text/GRUnitPrinter.st';
filein: 'Core/Text/GRUnsupportedEncodingError.st';
filein: 'Core/Utilities/GRDelayedSend.st';
filein: 'Core/Utilities/GRBoundDelayedSend.st';
filein: 'Core/Utilities/GRUnboundDelayedSend.st';
filein: 'Core/Utilities/GRInvalidArgumentCount.st';
filein: 'GST/Core/Extensions.st';
filein: 'GST/Core/GRGSTGenericCodec.st';
filein: 'GST/Core/GRGSTPlatform.st';
filein: 'GST/Core/GRGSTRandomProvider.st';
filein: 'Tests/Core/GRCodecTest.st';
filein: 'Tests/Core/GRCollectionTest.st';
filein: 'Tests/Core/GRAbstractDictionaryTest.st';
filein: 'Tests/Core/GRDictionaryTest.st';
filein: 'Tests/Core/GRIdentityDictionaryTest.st';
filein: 'Tests/Core/GRArrayTest.st';
filein: 'Tests/Core/GRBagTest.st';
filein: 'Tests/Core/GRIntervalTest.st';
filein: 'Tests/Core/GROrderedCollectionTest.st';
filein: 'Tests/Core/GRSetTest.st';
filein: 'Tests/Core/GRStringTest.st';
filein: 'Tests/Core/GRDelayedSendTest.st';
filein: 'Tests/Core/GRDurationTest.st';
filein: 'Tests/Core/GRErrorStub.st';
filein: 'Tests/Core/GRExceptionTest.st';
filein: 'Tests/Core/GRNotificationStub.st';
filein: 'Tests/Core/GRNullCodecStreamTest.st';
filein: 'Tests/Core/GRNumberTest.st';
filein: 'Tests/Core/GRObjectStub.st';
filein: 'Tests/Core/GRObjectTest.st';
filein: 'Tests/Core/GRPackageTest.st';
filein: 'Tests/Core/GRPlatformTest.st';
filein: 'Tests/Core/GRPrinterTest.st';
filein: 'Tests/Core/GRSmallDictionaryTest.st';
filein: 'Tests/Core/GROrderedMultiMapTest.st';
filein: 'Tests/Core/GRUtf8CodecTest.st';
filein: 'Tests/Core/GRVersionTest.st';
filein: 'Tests/GST/Core/GRGSTPlatformTest.st';
buildXml
]

213
grease/package.xml Normal file
View File

@ -0,0 +1,213 @@
<package>
<name>Grease</name>
<url>git://github.com/NicolasPetton/Grease.git</url>
<namespace>Grease</namespace>
<prereq>Iconv</prereq>
<prereq>Digest</prereq>
<prereq>SUnit</prereq>
<test>
<filein>Tests/Core/GRCodecTest.st</filein>
<filein>Tests/Core/GRIntervalTest.st</filein>
<filein>Tests/Core/GRNumberTest.st</filein>
<filein>Tests/Core/GRDelayedSendTest.st</filein>
<filein>Tests/Core/GRExceptionTest.st</filein>
<filein>Tests/Core/GRDictionaryTest.st</filein>
<filein>Tests/Core/GRErrorStub.st</filein>
<filein>Tests/Core/GRObjectStub.st</filein>
<filein>Tests/Core/GRBagTest.st</filein>
<filein>Tests/Core/GRNullCodecStreamTest.st</filein>
<filein>Tests/Core/GRVersionTest.st</filein>
<filein>Tests/Core/GRDurationTest.st</filein>
<filein>Tests/Core/GRSmallDictionaryTest.st</filein>
<filein>Tests/Core/GRUtf8CodecTest.st</filein>
<filein>Tests/Core/GRSetTest.st</filein>
<filein>Tests/Core/GRPlatformTest.st</filein>
<filein>Tests/Core/GRPrinterTest.st</filein>
<filein>Tests/Core/GRObjectTest.st</filein>
<filein>Tests/Core/GRNotificationStub.st</filein>
<filein>Tests/Core/GRPackageTest.st</filein>
<filein>Tests/Core/GRCollectionTest.st</filein>
<filein>Tests/Core/GRArrayTest.st</filein>
<filein>Tests/Core/GROrderedMultiMapTest.st</filein>
<filein>Tests/Core/GROrderedCollectionTest.st</filein>
<filein>Tests/Core/GRIdentityDictionaryTest.st</filein>
<filein>Tests/Core/GRStringTest.st</filein>
<filein>Tests/Core/GRAbstractDictionaryTest.st</filein>
<filein>Tests/GST/Core/GRGSTPlatformTest.st</filein>
<file>Tests/Core/GRCodecTest.st</file>
<file>Tests/Core/GRIntervalTest.st</file>
<file>Tests/Core/GRNumberTest.st</file>
<file>Tests/Core/GRDelayedSendTest.st</file>
<file>Tests/Core/GRExceptionTest.st</file>
<file>Tests/Core/GRDictionaryTest.st</file>
<file>Tests/Core/GRErrorStub.st</file>
<file>Tests/Core/GRObjectStub.st</file>
<file>Tests/Core/GRBagTest.st</file>
<file>Tests/Core/GRNullCodecStreamTest.st</file>
<file>Tests/Core/GRVersionTest.st</file>
<file>Tests/Core/GRDurationTest.st</file>
<file>Tests/Core/GRSmallDictionaryTest.st</file>
<file>Tests/Core/GRUtf8CodecTest.st</file>
<file>Tests/Core/GRSetTest.st</file>
<file>Tests/Core/GRPlatformTest.st</file>
<file>Tests/Core/GRPrinterTest.st</file>
<file>Tests/Core/GRObjectTest.st</file>
<file>Tests/Core/GRNotificationStub.st</file>
<file>Tests/Core/GRPackageTest.st</file>
<file>Tests/Core/GRCollectionTest.st</file>
<file>Tests/Core/GRArrayTest.st</file>
<file>Tests/Core/GROrderedMultiMapTest.st</file>
<file>Tests/Core/GROrderedCollectionTest.st</file>
<file>Tests/Core/GRIdentityDictionaryTest.st</file>
<file>Tests/Core/GRStringTest.st</file>
<file>Tests/Core/GRAbstractDictionaryTest.st</file>
<file>Tests/GST/Core/GRGSTPlatformTest.st</file>
<sunit>
Grease.GRCodecTest
Grease.GRIntervalTest
Grease.GRNumberTest
Grease.GRDelayedSendTest
Grease.GRExceptionTest
Grease.GRDictionaryTest
Grease.GRBagTest
Grease.GRNullCodecStreamTest
Grease.GRVersionTest
Grease.GRDurationTest
Grease.GRSmallDictionaryTest
Grease.GRUtf8CodecTest
Grease.GRSetTest
Grease.GRPlatformTest
Grease.GRPrinterTest
Grease.GRObjectTest
Grease.GRPackageTest
Grease.GRCollectionTest
Grease.GRArrayTest
Grease.GROrderedMultiMapTest
Grease.GROrderedCollectionTest
Grease.GRIdentityDictionaryTest
Grease.GRStringTest
Grease.GRAbstractDictionaryTest
Grease.GRGSTPlatformTest
</sunit>
</test>
<filein>Core/GRObject.st</filein>
<filein>Core/GRPlatform.st</filein>
<filein>Core/GRPackage.st</filein>
<filein>Core/GRVersion.st</filein>
<filein>Core/Exceptions.st</filein>
<filein>Core/Extensions.st</filein>
<filein>Core/Collections/GRSmallDictionary.st</filein>
<filein>Core/Collections/GROrderedMultiMap.st</filein>
<filein>Core/Text/GRCodec.st</filein>
<filein>Core/Text/GRNullCodec.st</filein>
<filein>Core/Text/GRCodecStream.st</filein>
<filein>Core/Text/GRNullCodecStream.st</filein>
<filein>Core/Text/GRInflector.st</filein>
<filein>Core/Text/GRInvalidUtf8Error.st</filein>
<filein>Core/Text/GRPrinter.st</filein>
<filein>Core/Text/GRMappedPrinter.st</filein>
<filein>Core/Text/GRNumberPrinter.st</filein>
<filein>Core/Text/GROrdinalizePrinter.st</filein>
<filein>Core/Text/GRPluggablePrinter.st</filein>
<filein>Core/Text/GRSequentialPrinter.st</filein>
<filein>Core/Text/GRSignPrinter.st</filein>
<filein>Core/Text/GRStringPrinter.st</filein>
<filein>Core/Text/GRUnitPrinter.st</filein>
<filein>Core/Text/GRUnsupportedEncodingError.st</filein>
<filein>Core/Utilities/GRDelayedSend.st</filein>
<filein>Core/Utilities/GRBoundDelayedSend.st</filein>
<filein>Core/Utilities/GRUnboundDelayedSend.st</filein>
<filein>Core/Utilities/GRInvalidArgumentCount.st</filein>
<filein>GST/Core/Extensions.st</filein>
<filein>GST/Core/GRGSTGenericCodec.st</filein>
<filein>GST/Core/GRGSTPlatform.st</filein>
<filein>GST/Core/GRGSTRandomProvider.st</filein>
<filein>Tests/Core/GRCodecTest.st</filein>
<filein>Tests/Core/GRCollectionTest.st</filein>
<filein>Tests/Core/GRAbstractDictionaryTest.st</filein>
<filein>Tests/Core/GRDictionaryTest.st</filein>
<filein>Tests/Core/GRIdentityDictionaryTest.st</filein>
<filein>Tests/Core/GRArrayTest.st</filein>
<filein>Tests/Core/GRBagTest.st</filein>
<filein>Tests/Core/GRIntervalTest.st</filein>
<filein>Tests/Core/GROrderedCollectionTest.st</filein>
<filein>Tests/Core/GRSetTest.st</filein>
<filein>Tests/Core/GRStringTest.st</filein>
<filein>Tests/Core/GRDelayedSendTest.st</filein>
<filein>Tests/Core/GRDurationTest.st</filein>
<filein>Tests/Core/GRErrorStub.st</filein>
<filein>Tests/Core/GRExceptionTest.st</filein>
<filein>Tests/Core/GRNotificationStub.st</filein>
<filein>Tests/Core/GRNullCodecStreamTest.st</filein>
<filein>Tests/Core/GRNumberTest.st</filein>
<filein>Tests/Core/GRObjectStub.st</filein>
<filein>Tests/Core/GRObjectTest.st</filein>
<filein>Tests/Core/GRPackageTest.st</filein>
<filein>Tests/Core/GRPlatformTest.st</filein>
<filein>Tests/Core/GRPrinterTest.st</filein>
<filein>Tests/Core/GRSmallDictionaryTest.st</filein>
<filein>Tests/Core/GROrderedMultiMapTest.st</filein>
<filein>Tests/Core/GRUtf8CodecTest.st</filein>
<filein>Tests/Core/GRVersionTest.st</filein>
<filein>Tests/GST/Core/GRGSTPlatformTest.st</filein>
<file>Core/GRObject.st</file>
<file>Core/GRPlatform.st</file>
<file>Core/GRPackage.st</file>
<file>Core/GRVersion.st</file>
<file>Core/Exceptions.st</file>
<file>Core/Extensions.st</file>
<file>Core/Collections/GRSmallDictionary.st</file>
<file>Core/Collections/GROrderedMultiMap.st</file>
<file>Core/Text/GRCodec.st</file>
<file>Core/Text/GRNullCodec.st</file>
<file>Core/Text/GRCodecStream.st</file>
<file>Core/Text/GRNullCodecStream.st</file>
<file>Core/Text/GRInflector.st</file>
<file>Core/Text/GRInvalidUtf8Error.st</file>
<file>Core/Text/GRPrinter.st</file>
<file>Core/Text/GRMappedPrinter.st</file>
<file>Core/Text/GRNumberPrinter.st</file>
<file>Core/Text/GROrdinalizePrinter.st</file>
<file>Core/Text/GRPluggablePrinter.st</file>
<file>Core/Text/GRSequentialPrinter.st</file>
<file>Core/Text/GRSignPrinter.st</file>
<file>Core/Text/GRStringPrinter.st</file>
<file>Core/Text/GRUnitPrinter.st</file>
<file>Core/Text/GRUnsupportedEncodingError.st</file>
<file>Core/Utilities/GRDelayedSend.st</file>
<file>Core/Utilities/GRBoundDelayedSend.st</file>
<file>Core/Utilities/GRUnboundDelayedSend.st</file>
<file>Core/Utilities/GRInvalidArgumentCount.st</file>
<file>GST/Core/Extensions.st</file>
<file>GST/Core/GRGSTGenericCodec.st</file>
<file>GST/Core/GRGSTPlatform.st</file>
<file>GST/Core/GRGSTRandomProvider.st</file>
<file>Tests/Core/GRCodecTest.st</file>
<file>Tests/Core/GRCollectionTest.st</file>
<file>Tests/Core/GRAbstractDictionaryTest.st</file>
<file>Tests/Core/GRDictionaryTest.st</file>
<file>Tests/Core/GRIdentityDictionaryTest.st</file>
<file>Tests/Core/GRArrayTest.st</file>
<file>Tests/Core/GRBagTest.st</file>
<file>Tests/Core/GRIntervalTest.st</file>
<file>Tests/Core/GROrderedCollectionTest.st</file>
<file>Tests/Core/GRSetTest.st</file>
<file>Tests/Core/GRStringTest.st</file>
<file>Tests/Core/GRDelayedSendTest.st</file>
<file>Tests/Core/GRDurationTest.st</file>
<file>Tests/Core/GRErrorStub.st</file>
<file>Tests/Core/GRExceptionTest.st</file>
<file>Tests/Core/GRNotificationStub.st</file>
<file>Tests/Core/GRNullCodecStreamTest.st</file>
<file>Tests/Core/GRNumberTest.st</file>
<file>Tests/Core/GRObjectStub.st</file>
<file>Tests/Core/GRObjectTest.st</file>
<file>Tests/Core/GRPackageTest.st</file>
<file>Tests/Core/GRPlatformTest.st</file>
<file>Tests/Core/GRPrinterTest.st</file>
<file>Tests/Core/GRSmallDictionaryTest.st</file>
<file>Tests/Core/GROrderedMultiMapTest.st</file>
<file>Tests/Core/GRUtf8CodecTest.st</file>
<file>Tests/Core/GRVersionTest.st</file>
<file>Tests/GST/Core/GRGSTPlatformTest.st</file>
</package>