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

More tests

This commit is contained in:
Nicolas Petton 2010-03-11 17:57:34 +01:00
parent 776f82bd38
commit f0a11dc66b
21 changed files with 2129 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
Core/Extensions.st
View File

@ -6,10 +6,20 @@ Object extend [
details: detailsString;
signal: apiString
]
isCollection [
<category: '*Grease-Core'>
^false
]
]
String extend [
beginsWith: aString [
<category: '*Grease-GST-Core'>
^self startsWith: aString
]
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."
@ -157,6 +167,36 @@ Number extend [
"Answer an integer of the receiver, in our case we simply truncate the number."
^ self truncated
]
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
]
]
Integer extend [
@ -179,6 +219,37 @@ Integer extend [
]
]
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
]
]
Duration extend [
milliseconds [
<category: '*Grease-GST-Core'>
^0
]
]
Character extend [
print: anObject on: aStream [

4
Core/Text/GRNullCodecStream.st
View File

@ -23,7 +23,7 @@ GRCodecStream subclass: GRNullCodecStream [
<category: 'streaming'>
aCharacterOrByte isCharacter
ifTrue: [stream nextPut: aCharacterOrByte]
ifFalse: [stream nextPut: (Character codePoint: aCharacterOrByte)]
ifFalse: [stream nextPut: (Character value: aCharacterOrByte)]
]
nextPutAll: aStringOrByteArray [
@ -32,6 +32,6 @@ GRCodecStream subclass: GRNullCodecStream [
ifTrue: [stream nextPutAll: aStringOrByteArray]
ifFalse: [1
to: aStringOrByteArray size
do: [:index | stream nextPut: (Character codePoint: (aStringOrByteArray at: index))]]
do: [:index | stream nextPut: (Character value: (aStringOrByteArray at: index))]]
]
]

312
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 ]
]

85
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
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
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
]
]

2
Tests/Core/GRCodecTest.st
View File

@ -116,7 +116,7 @@ TestCase subclass: GRCodecTest [
^String streamContents:
[:stream |
aCollectionOfIntegers
do: [:each | stream nextPut: (Character codePoint: each)]]
do: [:each | stream nextPut: (Character value: each)]]
]
seasideByteArray [

291
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
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
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
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
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
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
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
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
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
]
]

36
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
]
]

36
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
]
]

269
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
]
isSeqenced [
<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 = ''
]
]

62
package.st Normal file
View File

@ -0,0 +1,62 @@
Eval [
PackageBuilder new
name: 'Grease';
namespace: 'Grease';
prereq: 'Iconv';
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: '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';
buildXml
]

84
package.xml
View File

@ -2,6 +2,58 @@
<name>Grease</name>
<url>git://github.com/NicolasPetton/Grease.git</url>
<namespace>Grease</namespace>
<prereq>Iconv</prereq>
<prereq>SUnit</prereq>
<test>
<filein>Tests/Core/GRAbstractDictionaryTest.st</filein>
<filein>Tests/Core/GRNotificationStub.st</filein>
<filein>Tests/Core/GRDurationTest.st</filein>
<filein>Tests/Core/GRSetTest.st</filein>
<filein>Tests/Core/GRIntervalTest.st</filein>
<filein>Tests/Core/GRArrayTest.st</filein>
<filein>Tests/Core/GRExceptionTest.st</filein>
<filein>Tests/Core/GRDictionaryTest.st</filein>
<filein>Tests/Core/GRErrorStub.st</filein>
<filein>Tests/Core/GRDelayedSendTest.st</filein>
<filein>Tests/Core/GRCollectionTest.st</filein>
<filein>Tests/Core/GRIdentityDictionaryTest.st</filein>
<filein>Tests/Core/GROrderedCollectionTest.st</filein>
<filein>Tests/Core/GRBagTest.st</filein>
<filein>Tests/Core/GRCodecTest.st</filein>
<filein>Tests/Core/GRStringTest.st</filein>
<file>Tests/Core/GRAbstractDictionaryTest.st</file>
<file>Tests/Core/GRNotificationStub.st</file>
<file>Tests/Core/GRDurationTest.st</file>
<file>Tests/Core/GRSetTest.st</file>
<file>Tests/Core/GRIntervalTest.st</file>
<file>Tests/Core/GRArrayTest.st</file>
<file>Tests/Core/GRExceptionTest.st</file>
<file>Tests/Core/GRDictionaryTest.st</file>
<file>Tests/Core/GRErrorStub.st</file>
<file>Tests/Core/GRDelayedSendTest.st</file>
<file>Tests/Core/GRCollectionTest.st</file>
<file>Tests/Core/GRIdentityDictionaryTest.st</file>
<file>Tests/Core/GROrderedCollectionTest.st</file>
<file>Tests/Core/GRBagTest.st</file>
<file>Tests/Core/GRCodecTest.st</file>
<file>Tests/Core/GRStringTest.st</file>
<sunit>
Grease.GRAbstractDictionaryTest
Grease.GRDurationTest
Grease.GRSetTest
Grease.GRIntervalTest
Grease.GRArrayTest
Grease.GRExceptionTest
Grease.GRDictionaryTest
Grease.GRDelayedSendTest
Grease.GRCollectionTest
Grease.GRIdentityDictionaryTest
Grease.GROrderedCollectionTest
Grease.GRBagTest
Grease.GRCodecTest
Grease.GRStringTest
</sunit>
</test>
<filein>Core/GRObject.st</filein>
<filein>Core/GRPlatform.st</filein>
<filein>Core/GRPackage.st</filein>
@ -30,6 +82,22 @@
<filein>Core/Utilities/GRBoundDelayedSend.st</filein>
<filein>Core/Utilities/GRUnboundDelayedSend.st</filein>
<filein>Core/Utilities/GRInvalidArgumentCount.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>
<file>Core/GRObject.st</file>
<file>Core/GRPlatform.st</file>
<file>Core/GRPackage.st</file>
@ -58,4 +126,20 @@
<file>Core/Utilities/GRBoundDelayedSend.st</file>
<file>Core/Utilities/GRUnboundDelayedSend.st</file>
<file>Core/Utilities/GRInvalidArgumentCount.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>
</package>