diff --git a/grease/Core/Collections/GROrderedMultiMap.st b/grease/Core/Collections/GROrderedMultiMap.st new file mode 100644 index 0000000..68d86fe --- /dev/null +++ b/grease/Core/Collections/GROrderedMultiMap.st @@ -0,0 +1,48 @@ +GRSmallDictionary subclass: GROrderedMultiMap [ + + + + + add: anAssociation [ + + self privateAt: anAssociation key put: anAssociation value. + ^anAssociation + ] + + allAt: aKey [ + + ^Array streamContents: [:stream | + 1 to: size do: [:index | + (keys at: index) = aKey ifTrue: [ + stream nextPut: (values at: index)]]] + ] + + allAt: aKey ifAbsent: absentBlock [ + + | 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." + + + ^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." + + + | removed | + removed := Array streamContents: [:stream | | index | + [(index := self findIndexFor: aKey) = 0] + whileFalse: [stream nextPut: (self removeIndex: index)]]. + ^removed isEmpty ifTrue: [aBlock value] ifFalse: [removed] + ] +] + diff --git a/grease/Core/Collections/GRSmallDictionary.st b/grease/Core/Collections/GRSmallDictionary.st new file mode 100644 index 0000000..ff26f4a --- /dev/null +++ b/grease/Core/Collections/GRSmallDictionary.st @@ -0,0 +1,244 @@ +GRObject subclass: GRSmallDictionary [ + | size keys values | + + + + + GRSmallDictionary class [ + + new [ + + ^self new: 3 + ] + + new: anInteger [ + + ^self basicNew initialize: anInteger + ] + + withAll: aCollection [ + + ^self new addAll: aCollection; yourself + ] +] + + initialize: anInteger [ + + size := 0. + keys := Array new: anInteger. + values := Array new: anInteger + ] + + isEmpty [ + + ^size = 0 + ] + + isDictionary [ + + ^true + ] + + isCollection [ + + ^true + ] + + add: anAssociation [ + + self at: anAssociation key put: anAssociation value. + ^anAssociation + ] + + addAll: aDictionary [ + + 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." + + + ^self at: aKey ifAbsent: [self errorKeyNotFound] + ] + + at: aKey ifAbsent: aBlock [ + "Answer the value associated with aKey. Evaluate aBlock, if no such key is defined." + + + | 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." + + + | 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." + + + | 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." + + + | 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." + + + ^(self findIndexFor: aKey) ~= 0 + ] + + keys [ + + ^keys copyFrom: 1 to: size + ] + + associations [ + "Answer a Collection containing the receiver's associations." + + + | result | + result := WriteStream on: (Array new: self size). + self associationsDo: [:assoc | result nextPut: assoc]. + ^result contents + ] + + associationsDo: aBlock [ + + self keysAndValuesDo: [:key :value | aBlock value: key -> value] + ] + + do: aBlock [ + + 1 to: size do: [ :index | aBlock value: (values at: index) ] + ] + + keysAndValuesDo: aBlock [ + + 1 to: size + do: [:index | aBlock value: (keys at: index) value: (values at: index)] + ] + + postCopy [ + + super postCopy. + keys := keys copy. + values := values copy + ] + + size [ + + ^size + ] + + grow [ + + | 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 [ + + self error: 'Key not found' + ] + + findIndexFor: aKey [ + + 1 to: size do: [:index | (keys at: index) = aKey ifTrue: [^index]]. + ^0 + ] + + removeIndex: index [ + + | 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 [ + + size = keys size ifTrue: [self grow]. + keys at: (size := size + 1) put: aKey. + ^values at: size put: aValue + ] + + values [ + + ^values copyFrom: 1 to: size + ] + + valuesDo: aBlock [ + + 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." + + + ^self removeKey: aKey ifAbsent: [self errorKeyNotFound] + ] + + keysDo: aBlock [ + + 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." + + + | 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 + ] + +] + diff --git a/grease/Core/Exceptions.st b/grease/Core/Exceptions.st new file mode 100644 index 0000000..aca48a2 --- /dev/null +++ b/grease/Core/Exceptions.st @@ -0,0 +1,53 @@ +Error subclass: GRError [ + + + + + GRError class >> new [ + + ^super new initialize + ] + + initialize [ + + ] +] + +Notification subclass: GRNotification [ + + + + + GRNotification class >> new [ + + ^super new initialize + ] + + initialize [ + + ] + +] + +GRNotification subclass: GRDeprecatedApiNotification [ + | details | + + + >#seasideDeprecatedApi:details: '> + + details [ + + ^details + ] + + details: anObject [ + + details := anObject + ] +] diff --git a/grease/Core/Extensions.st b/grease/Core/Extensions.st new file mode 100644 index 0000000..fa14863 --- /dev/null +++ b/grease/Core/Extensions.st @@ -0,0 +1,222 @@ +Object extend [ + + greaseDeprecatedApi: apiString details: detailsString [ + + Grease.GRDeprecatedApiNotification new + details: detailsString; + signal: apiString + ] + + isCollection [ + + ^false + ] + + greaseString [ + + ^self printString + ] +] + +String extend [ + + greaseString [ + + ^self + ] + + excerpt: aString [ + + "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 [ + + "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 [ + + "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 [ + + "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 [ + + ^ Grease.GRInflector pluralize: self + ] + + print: anObject on: aStream [ + + aStream nextPutAll: self + ] + + trimBoth [ + + "Trim separators from both sides of the receiving string." + + ^ self trimBoth: [ :char | char isSeparator ] + ] + + trimBoth: aBlock [ + + "Trim characters satisfying the condition given in aBlock from both sides of the receiving string." + + ^ self trimLeft: aBlock right: aBlock + ] + + trimLeft [ + + "Trim separators from the left side of the receiving string." + + ^ self trimLeft: [ :char | char isSeparator ] + ] + + trimLeft: aBlock [ + + "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 [ + + "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 [ + + "Trim separators from the right side of the receiving string." + + ^ self trimRight: [ :char | char isSeparator ] + ] + + trimRight: aBlock [ + + "Trim characters satisfying the condition given in aBlock from the right side of the receiving string." + + ^ self trimLeft: [ :char | false ] right: aBlock + ] + + truncate [ + + "Truncate the receiver to 30 characters." + + ^ self truncate: 30 + ] + + truncate: anInteger [ + + "Truncate the receiver to anInteger characters." + + ^ self truncate: anInteger ellipsis: '...' + ] + + truncate: anInteger ellipsis: aString [ + + "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 [ + + ^self asString + ] +] + +Number extend [ + + greaseInteger [ + + "Answer an integer of the receiver, in our case we simply truncate the number." + ^ self truncated + ] +] + +Integer extend [ + + greaseInteger [ + + ^ self + ] + + pluralize: aSingularString [ + + ^ self + pluralize: aSingularString + with: (Grease.GRInflector pluralize: aSingularString) + ] + + pluralize: aSingularString with: aPluralString [ + + ^ self printString , ' ' , (self abs = 1 ifTrue: [ aSingularString ] ifFalse: [ aPluralString ]) + ] +] + +Character extend [ + + print: anObject on: aStream [ + + aStream nextPut: self + ] + + greaseString [ + + ^self asString + ] +] + +UndefinedObject extend [ + print: anObject on: aStream [ + + ] +] diff --git a/grease/Core/GRObject.st b/grease/Core/GRObject.st new file mode 100644 index 0000000..0900d49 --- /dev/null +++ b/grease/Core/GRObject.st @@ -0,0 +1,32 @@ +Object subclass: GRObject [ + + + + + GRObject class >> defaultErrorClass [ + + ^GRError + ] + + GRObject class >> error: aString [ + + ^self defaultErrorClass signal: aString + ] + + GRObject class >> new [ + + ^self basicNew initialize + ] + + error: aString [ + + ^self class error: aString + ] + + initialize [ + + + ] +] + diff --git a/grease/Core/GRPackage.st b/grease/Core/GRPackage.st new file mode 100644 index 0000000..a70c1ff --- /dev/null +++ b/grease/Core/GRPackage.st @@ -0,0 +1,168 @@ +GRObject subclass: GRPackage [ + | name description dependencies license url | + + + + + + GRPackage class >> greaseTestsCore [ + + ^(self new) + name: 'Grease-Tests-Core'; + description: 'Unit tests for the package Grease-Core.'; + addDependency: 'Grease-Core'; + url: #seasideUrl; + yourself + ] + + GRPackage class >> greaseCore [ + + ^(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." + + + | 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 [ + + super initialize. + dependencies := OrderedCollection new. + license := #MIT + ] + + description [ + "Answer a short description of the package." + + + ^description + ] + + description: aString [ + + description := aString + ] + + license [ + "Answer the current license of this package, by default MIT is used." + + + ^license + ] + + license: aSymbol [ + + 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." + + + ^name + ] + + name: aString [ + + name := aString + ] + + url [ + "Answer the base-URL of the package. This string is only meaningful for platforms that can directly access Monticello repositories." + + + ^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." + + + url := aStringOrSymbol + ] + + addDependency: aString [ + + dependencies add: aString + ] + + allDependencies [ + "Answer all dependencies on which this package depends." + + + ^self addDependenciesTo: OrderedCollection new + ] + + dependencies [ + "Return a collection of package names on which this package depends." + + + ^dependencies + ] + + resolveWith: aDictionary [ + + dependencies := dependencies collect: + [:each | + aDictionary at: each + ifAbsent: + [self error: self name printString , ' depends on unknown package ' + , each printString]] + ] + + printOn: aStream [ + + super printOn: aStream. + aStream + nextPut: $(; + nextPutAll: self name; + nextPut: $) + ] + + isLGPL [ + + ^self license = #LGPL + ] + + isMIT [ + + ^self license = #MIT + ] + + addDependenciesTo: aCollection [ + + (aCollection includes: self) + ifFalse: + [self dependencies do: [:each | each addDependenciesTo: aCollection]. + aCollection add: self]. + ^aCollection + ] + + seasideLGPLUrl [ + + ^'http://www.squeaksource.com/Seaside30LGPL' + ] + + seasideUrl [ + + ^'http://www.squeaksource.com/Seaside30' + ] +] + diff --git a/grease/Core/GRPlatform.st b/grease/Core/GRPlatform.st new file mode 100644 index 0000000..00d0ede --- /dev/null +++ b/grease/Core/GRPlatform.st @@ -0,0 +1,259 @@ +GRObject subclass: GRPlatform [ + + + + + + Current := nil. + + GRPlatform class >> current [ + + ^Current + ] + + GRPlatform class >> current: aPlatform [ + + Current := aPlatform + ] + + GRPlatform class >> select [ + + GRPlatform current: self new + ] + + GRPlatform class >> unselect [ + + GRPlatform current class = self ifTrue: [GRPlatform current: nil] + ] + + secureHashFor: aString [ + + self subclassResponsibility + ] + + base64Decode: aString [ + + self subclassResponsibility + ] + + openDebuggerOn: anError [ + + self subclassResponsibility + ] + + stackDepth [ + + 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." + + + self subclassResponsibility + ] + + readWriteByteStream [ + "Return a ReadWriteStream on a ByteArray that stores integers 0..255 + ^ReadWriteStream on: ByteArray new + " + + + ^self subclassResponsibility + ] + + readWriteCharacterStream [ + "Return a ReadWriteStream on a String that stores characters + ^ReadWriteStream on: String new + " + + + ^self subclassResponsibility + ] + + reducedConflictDictionary [ + "used by Gemstone/S reduced conflict classes that can be used to avoid transaction conflicts" + + + ^Dictionary + ] + + semaphoreClass [ + "used by Gemstone/S traditional Semaphores which cannot be persisted" + + + self subclassResponsibility + ] + + weakDictionaryOfSize: aNumber [ + + self subclassResponsibility + ] + + asMethodReturningByteArray: aByteArrayOrString named: aSymbol [ + "Generates the source of a method named aSymbol that returns aByteArrayOrString as a ByteArray" + + + 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." + + + self subclassResponsibility + ] + + contentsOfFile: aString binary: aBoolean [ + + self subclassResponsibility + ] + + convertToSmalltalkNewlines: aString [ + "convert any line endings (CR, CRLF, LF) to CR" + + + self subclassResponsibility + ] + + ensureExistenceOfFolder: aString [ + "creates a folder named aString in the image directory" + + + 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 ." + + + 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'." + + + self subclassResponsibility + ] + + removeSelector: aSymbol from: aClass [ + + self subclassResponsibility + ] + + write: aStringOrByteArray toFile: aFileNameString inFolder: aFolderString [ + "writes aStringOrByteArray to a file named aFilenameString in the folder aFolderString" + + + self subclassResponsibility + ] + + isProcessTerminated: aProcess [ + "Return a boolean indicating whether aProcess has been terminated." + + + self subclassResponsibility + ] + + terminateProcess: aProcess [ + "Permanently terminate the process, unwinding first to execute #ensure: and #ifCurtailed: blocks." + + + self subclassResponsibility + ] + + addToShutDownList: anObject [ + "Add anObject to the shutdown-list of the system. On shutdown the message #shutDown will be sent to anObject." + + + self subclassResponsibility + ] + + addToStartUpList: anObject [ + "Add anObject to the startup-list of the system. On startup the message #startUp will be sent to anObject." + + + self subclassResponsibility + ] + + removeFromShutDownList: anObject [ + "Remove anObject from the shutdown list in the system." + + + self subclassResponsibility + ] + + removeFromStartUpList: anObject [ + "Remove anObject from the startup list in the system." + + + self subclassResponsibility + ] + + newline [ + "Answer the system's default newline character (sequence)." + + + 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" + + + ^aBlock value + ] + + label [ + "Answer a descriptive label string for the platform implementation" + + + self subclassResponsibility + ] + + version [ + "Answer the Grease version" + + + ^(GRVersion major: 1 minor: 0) + beAlpha: 6; + yourself + ] + + versionString [ + + ^String streamContents: + [:stream | + stream + nextPutAll: self version greaseString; + nextPutAll: ' ('; + nextPutAll: self label; + nextPut: $)] + ] +] + diff --git a/grease/Core/GRVersion.st b/grease/Core/GRVersion.st new file mode 100644 index 0000000..21723e5 --- /dev/null +++ b/grease/Core/GRVersion.st @@ -0,0 +1,190 @@ +GRObject subclass: GRVersion [ + | major minor revision stageLabel stageNumber | + + + + + GRVersion class >> major: majorInteger [ + + ^self major: majorInteger minor: nil + ] + + GRVersion class >> major: majorInteger minor: minorInteger [ + + ^self + major: majorInteger + minor: minorInteger + revision: nil + ] + + GRVersion class >> major: majorInteger minor: minorInteger revision: revisionInteger [ + + ^(self basicNew) + initializeWithMajor: majorInteger + minor: minorInteger + revision: revisionInteger; + yourself + ] + + GRVersion class >> new [ + + ^self major: 1 + ] + + initializeWithMajor: majorInteger minor: minorInteger revision: revisionInteger [ + + self initialize. + major := majorInteger. + minor := minorInteger. + revision := revisionInteger + ] + + < otherVersion [ + + 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 [ + + ^(self > otherVersion) not + ] + + = otherVersion [ + + ^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 [ + + ^otherVersion < self + ] + + >= otherVersion [ + + ^(self < otherVersion) not + ] + + hash [ + + ^(major hash bitXor: minor hash) bitXor: revision hash + ] + + beAlpha [ + + self beAlpha: nil + ] + + beAlpha: anInteger [ + + self stage: #alpha number: anInteger + ] + + beBeta [ + + self beBeta: nil + ] + + beBeta: anInteger [ + + self stage: #beta number: anInteger + ] + + beFinal [ + + self stage: nil number: nil + ] + + greaseString [ + + ^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 [ + + ^stageLabel = #alpha + ] + + isBeta [ + + ^stageLabel = #beta + ] + + isFinal [ + + ^stageLabel isNil + ] + + major [ + + ^major + ] + + major: anInteger [ + + major := anInteger + ] + + minor [ + + ^minor + ] + + minor: anInteger [ + + minor := anInteger + ] + + revision [ + + ^revision + ] + + revision: anInteger [ + + revision := anInteger + ] + + stage [ + + ^stageLabel + ] + + stage: aSymbol number: anInteger [ + + stageLabel := aSymbol. + stageNumber := anInteger + ] + + stageNumber [ + + ^stageNumber + ] +] + diff --git a/grease/Core/Text/GRCodec.st b/grease/Core/Text/GRCodec.st new file mode 100644 index 0000000..ec31c19 --- /dev/null +++ b/grease/Core/Text/GRCodec.st @@ -0,0 +1,107 @@ +GRObject subclass: GRCodec [ + + + + + GRCodec class >> allCodecs [ + "Answer all codecs supported in this system. This is a collection of codec instances." + + + ^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." + + + ^#() + ] + + 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." + + + 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." + + + self subclassResponsibility + ] + + GRCodec class >> basicForEncoding: aString [ + "Create the actual instance." + + + self subclassResponsibility + ] + + GRCodec class >> unsupportedEncoding: aString [ + "Signal an unsupported encoding." + + + GRUnsupportedEncodingError signal: 'unsupported encoding: ' , aString + ] + + name [ + "Answer a human readable string of the receivers encoding policy." + + + 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." + + + self subclassResponsibility + ] + + decode: aString [ + + | 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 [ + + | 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." + + + 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." + + + self subclassResponsibility + ] + + printOn: aStream [ + + super printOn: aStream. + aStream + nextPutAll: ' name: '; + print: self name + ] +] + diff --git a/grease/Core/Text/GRCodecStream.st b/grease/Core/Text/GRCodecStream.st new file mode 100644 index 0000000..14a5da8 --- /dev/null +++ b/grease/Core/Text/GRCodecStream.st @@ -0,0 +1,91 @@ +GRObject subclass: GRCodecStream [ + | stream | + + + + stream - a WriteStream + + '> + + + GRCodecStream class >> on: aStream [ + + ^self basicNew initalizeOn: aStream + ] + + initalizeOn: aStream [ + + self initialize. + stream := aStream + ] + + binary [ + + + ] + + contents [ + + ^stream contents + ] + + flush [ + + stream flush + ] + + size [ + + ^stream size + ] + + text [ + + + ] + + crlf [ + + self + nextPut: Character cr; + nextPut: Character lf + ] + + next [ + + self subclassResponsibility + ] + + next: anInteger [ + + self subclassResponsibility + ] + + nextPut: aCharacter [ + + self subclassResponsibility + ] + + nextPutAll: aString [ + + self subclassResponsibility + ] + + space [ + + self nextPut: Character space + ] + + tab [ + + self nextPut: Character tab + ] + + atEnd [ + + ^stream atEnd + ] +] diff --git a/grease/Core/Text/GRInflector.st b/grease/Core/Text/GRInflector.st new file mode 100644 index 0000000..6816e88 --- /dev/null +++ b/grease/Core/Text/GRInflector.st @@ -0,0 +1,33 @@ +GRObject subclass: GRInflector [ + + + + + InflectionRules := nil. + Uninflected := nil. + + GRInflector class >> pluralize: aString [ + + | 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 [ + + 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 +] + diff --git a/grease/Core/Text/GRInvalidUtf8Error.st b/grease/Core/Text/GRInvalidUtf8Error.st new file mode 100644 index 0000000..f1266db --- /dev/null +++ b/grease/Core/Text/GRInvalidUtf8Error.st @@ -0,0 +1 @@ +GRError subclass: GRInvalidUtf8Error [] diff --git a/grease/Core/Text/GRMappedPrinter.st b/grease/Core/Text/GRMappedPrinter.st new file mode 100644 index 0000000..277e78f --- /dev/null +++ b/grease/Core/Text/GRMappedPrinter.st @@ -0,0 +1,36 @@ +GRPrinter subclass: GRMappedPrinter [ + | next block | + + + + + GRMappedPrinter class >> block: aBlock next: aPrinter [ + + ^(self new) + block: aBlock; + next: aPrinter; + yourself + ] + + block: aBlock [ + + block := aBlock + ] + + next: aPrinter [ + + next := aPrinter + ] + + initialize [ + + super initialize. + self block: [:value | value] + ] + + print: anObject on: aStream [ + + next print: (block value: anObject) on: aStream + ] +] + diff --git a/grease/Core/Text/GRNullCodec.st b/grease/Core/Text/GRNullCodec.st new file mode 100644 index 0000000..3a6feb0 --- /dev/null +++ b/grease/Core/Text/GRNullCodec.st @@ -0,0 +1,61 @@ +GRCodec subclass: GRNullCodec [ + + + + + GRNullCodec class >> codecs [ + + ^Array with: self new + ] + + GRNullCodec class >> supportsEncoding: aString [ + + ^aString isNil + ] + + GRNullCodec class >> basicForEncoding: aString [ + + ^self new + ] + + name [ + + ^'(none)' + ] + + url [ + "The selfish method. Let's do it with ourselves." + + + ^self + ] + + decode: aString [ + "Overridden for efficencey." + + + ^aString + ] + + encode: aString [ + "Overridden for efficencey." + + + ^aString + ] + + decoderFor: aReadStream [ + "wrap to avoid String vs ByteArray issues" + + + ^GRNullCodecStream on: aReadStream + ] + + encoderFor: aWriteStream [ + "wrap to avoid String vs ByteArray issues" + + + ^GRNullCodecStream on: aWriteStream + ] +] + diff --git a/grease/Core/Text/GRNullCodecStream.st b/grease/Core/Text/GRNullCodecStream.st new file mode 100644 index 0000000..253f277 --- /dev/null +++ b/grease/Core/Text/GRNullCodecStream.st @@ -0,0 +1,37 @@ +GRCodecStream subclass: GRNullCodecStream [ + + + + stream + - a WriteStream on a String'> + + + next [ + + ^stream next + ] + + next: anInteger [ + + ^stream next: anInteger + ] + + nextPut: aCharacterOrByte [ + + aCharacterOrByte isCharacter + ifTrue: [stream nextPut: aCharacterOrByte] + ifFalse: [stream nextPut: (Character value: aCharacterOrByte)] + ] + + nextPutAll: aStringOrByteArray [ + + aStringOrByteArray isString + ifTrue: [stream nextPutAll: aStringOrByteArray] + ifFalse: [1 + to: aStringOrByteArray size + do: [:index | stream nextPut: (Character value: (aStringOrByteArray at: index))]] + ] +] diff --git a/grease/Core/Text/GRNumberPrinter.st b/grease/Core/Text/GRNumberPrinter.st new file mode 100644 index 0000000..a30bf59 --- /dev/null +++ b/grease/Core/Text/GRNumberPrinter.st @@ -0,0 +1,228 @@ +GRPrinter subclass: GRNumberPrinter [ + | characters base delimiter digits infinite nan padding accuracy precision separator | + + + base: + delimiter: + digits: + infinite: + nan: + padding: + precision: + separator: '> + + + NumbersToCharactersLowercase := nil. + NumbersToCharactersUppercase := nil. + + GRNumberPrinter class >> initialize [ + + NumbersToCharactersLowercase := '0123456789abcdefghijklmnopqrstuvwxyz'. + NumbersToCharactersUppercase := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' + ] + + accuracy: aFloat [ + "Round towards the nearest number that is a multiple of aFloat." + + + accuracy := aFloat + ] + + base: anInteger [ + "The numeric base to which the number should be printed." + + + base := anInteger + ] + + characters: aString [ + "The characters to be used to convert a number to a string." + + + characters := aString + ] + + delimiter: aCharacter [ + "The delimiter to separate the integer and fraction part of the number." + + + delimiter := aCharacter + ] + + digits: anInteger [ + "The number of digits to be printed in the integer part." + + + digits := anInteger + ] + + infinite: aString [ + "The string that should be displayed if the number is positive or negative infinity." + + + infinite := aString + ] + + nan: aString [ + "The string that should be displayed if the number is not a number." + + + nan := aString + ] + + padding: aCharacter [ + "The padding for the integer part." + + + padding := aCharacter + ] + + precision: anInteger [ + "The number of digits to be printed in the fraction part." + + + precision := anInteger + ] + + separator: aCharacter [ + "Separator character to be used to group digits." + + + separator := aCharacter + ] + + lowercase [ + "Use lowercase characters for numbers of base 10 and higher." + + + self characters: NumbersToCharactersLowercase + ] + + uppercase [ + "Use uppercase characters for numbers of base 10 and higher." + + + self characters: NumbersToCharactersUppercase + ] + + initialize [ + + super initialize. + self lowercase. + self base: 10. + self delimiter: $.. + self infinite: 'Infinite'. + self nan: 'NaN'. + self padding: $ . + self precision: 0 + ] + + print: aNumber on: aStream [ + + 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 [ + + | 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 [ + + | 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 [ + + infinite isNil ifFalse: [aStream nextPutAll: infinite] + ] + + printInteger: aNumber on: aStream [ + + | 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 [ + + nan isNil ifFalse: [aStream nextPutAll: nan] + ] + + digitsOf: aNumber base: aBaseInteger [ + "Answer the absolute digits of aNumber in the base aBaseInteger." + + + | 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." + + + | 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." + + + | 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 +] diff --git a/grease/Core/Text/GROrdinalizePrinter.st b/grease/Core/Text/GROrdinalizePrinter.st new file mode 100644 index 0000000..3706142 --- /dev/null +++ b/grease/Core/Text/GROrdinalizePrinter.st @@ -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 [ + + + + + print: anObject on: aStream [ + + aStream nextPutAll: (self ordinalize: anObject integerPart) + ] + + ordinalize: anInteger [ + + ^(anInteger \\ 100 between: 11 and: 13) + ifTrue: ['th'] + ifFalse: [#('st' 'nd' 'rd') at: anInteger \\ 10 ifAbsent: ['th']] + ] +] + diff --git a/grease/Core/Text/GRPluggablePrinter.st b/grease/Core/Text/GRPluggablePrinter.st new file mode 100644 index 0000000..ac301bb --- /dev/null +++ b/grease/Core/Text/GRPluggablePrinter.st @@ -0,0 +1,28 @@ +GRPrinter subclass: GRPluggablePrinter [ + | block | + + + + + GRPluggablePrinter class >> on: aBlock [ + + ^self new block: aBlock + ] + + block: aBlock [ + + block := aBlock + ] + + initialize [ + + super initialize. + self block: [:value | String new] + ] + + print: anObject on: aStream [ + + aStream nextPutAll: (block value: anObject) + ] +] + diff --git a/grease/Core/Text/GRPrinter.st b/grease/Core/Text/GRPrinter.st new file mode 100644 index 0000000..0a4a14e --- /dev/null +++ b/grease/Core/Text/GRPrinter.st @@ -0,0 +1,328 @@ +GRObject subclass: GRPrinter [ + + + + + 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" + + + ^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)" + + + ^self rfc1123 + ] + + GRPrinter class >> isoDate [ + "Ansers a printer that formats dates accoring to ISO(YYYY-MM-DD) E.g. + 2003-12-24" + + + ^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" + + + ^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" + + + ^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" + + + ^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 " + + + ^self abbreviatedWeekName , ', ' , self paddedDay , Character space + , self abbreviatedMonthName , Character space + , self paddedYear , Character space + , self isoTime , Character space + , aString + ] + + GRPrinter class >> swissCurrency [ + + ^GRSequentialPrinter new , 'CHF ' , GRSignPrinter new + , ((GRNumberPrinter new) + separator: $'; + precision: 2; + accuracy: 0.05; + yourself) + ] + + GRPrinter class >> usCurrency [ + + ^GRSignPrinter new , $$ , ((GRNumberPrinter new) + separator: $,; + precision: 2; + yourself) + ] + + GRPrinter class >> abbreviatedMonthName [ + + ^self + monthName: #('Jan' 'Feb' 'Mar' 'Apr' 'May' 'Jun' 'Jul' 'Aug' 'Sep' 'Oct' 'Nov' 'Dec') + ] + + GRPrinter class >> abbreviatedWeekName [ + + ^self weekName: #('Sun' 'Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat') + ] + + GRPrinter class >> absOffsetHoursPadded [ + + ^GRMappedPrinter block: [:date | date offset hours abs] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> absOffsetMinutesPadded [ + + ^GRMappedPrinter block: [:date | date offset minutes abs] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> fullMonthName [ + + ^self + monthName: #('January' 'February' 'March' 'April' 'May' 'June' 'July' 'August' 'September' 'October' 'November' 'December') + ] + + GRPrinter class >> fullWeekName [ + + ^self + weekName: #('Monday' 'Tuesday' 'Wednesday' 'Thursday' 'Friday' 'Saturday' 'Sunday') + ] + + GRPrinter class >> monthName: anArray [ + + ^GRPluggablePrinter on: [:date | anArray at: date monthIndex] + ] + + GRPrinter class >> offsetSign [ + + ^GRMappedPrinter block: [:date | date offset] + next: ((GRSignPrinter new) + positivePrinter: $+; + negativePrinter: $-; + yourself) + ] + + GRPrinter class >> paddedCentury [ + + ^GRMappedPrinter block: [:date | date year \\ 100] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedDay [ + + ^GRMappedPrinter block: [:date | date dayOfMonth] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedMonth [ + + ^GRMappedPrinter block: [:date | date monthIndex] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedYear [ + + ^GRMappedPrinter block: [:date | date year] + next: (self numberWithAtLeastDigits: 4) + ] + + GRPrinter class >> unpaddedCentury [ + + ^GRMappedPrinter block: [:date | date year \\ 100] + next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedDay [ + + ^GRMappedPrinter block: [:date | date dayOfMonth] next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedMonth [ + + ^GRMappedPrinter block: [:date | date monthIndex] next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedYear [ + + ^GRMappedPrinter block: [:date | date year] next: GRNumberPrinter new + ] + + GRPrinter class >> weekName: anArray [ + + ^GRPluggablePrinter on: [:date | anArray at: date dayOfWeek] + ] + + GRPrinter class >> paddedHour12 [ + + ^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedHour24 [ + + ^GRMappedPrinter block: [:time | time hour] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedMinute [ + + ^GRMappedPrinter block: [:time | time minute] + next: (self numberWithAtLeastDigits: 2) + ] + + GRPrinter class >> paddedSecond [ + + ^GRMappedPrinter block: [:time | time second] + next: ((GRNumberPrinter new) + padding: $0; + digits: 2) + ] + + GRPrinter class >> unpaddedHour12 [ + + ^GRMappedPrinter block: [:time | (time hour - 1) \\ 12 + 1] + next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedHour24 [ + + ^GRMappedPrinter block: [:time | time hour] next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedMinute [ + + ^GRMappedPrinter block: [:time | time minute] next: GRNumberPrinter new + ] + + GRPrinter class >> unpaddedSecond [ + + ^GRMappedPrinter block: [:time | time second] next: GRNumberPrinter new + ] + + GRPrinter class >> binaryFileSize [ + + ^GRUnitPrinter base: 1024 + units: #('byte' 'bytes' 'KiB' 'MiB' 'GiB' 'TiB' 'PiB' 'EiB' 'ZiB' 'YiB') + ] + + GRPrinter class >> decimalFileSize [ + + ^GRUnitPrinter base: 1000 + units: #('byte' 'bytes' 'kB' 'MB' 'GB' 'TB' 'PB' 'EB' 'ZB' 'YB') + ] + + GRPrinter class >> numberWithAtLeastDigits: anInteger [ + + ^(GRNumberPrinter new) + padding: $0; + digits: anInteger; + yourself + ] + + , aPrinter [ + + ^GRSequentialPrinter new , self , aPrinter + ] + + print: anObject [ + + ^String streamContents: [:stream | self print: anObject on: stream] + ] + + print: anObject on: aStream [ + "Subclasses override this method to produce some output." + + + + ] + + pad: aString center: aCharacter to: anInteger [ + "Pad to the center of aString with aCharacter to at least anInteger characters." + + + | 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." + + + | 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." + + + | result | + anInteger <= aString size ifTrue: [^aString]. + result := (String new: anInteger) atAllPut: aCharacter. + result + replaceFrom: 1 + to: aString size + with: aString + startingAt: 1. + ^result + ] +] diff --git a/grease/Core/Text/GRSequentialPrinter.st b/grease/Core/Text/GRSequentialPrinter.st new file mode 100644 index 0000000..fb1b7b4 --- /dev/null +++ b/grease/Core/Text/GRSequentialPrinter.st @@ -0,0 +1,22 @@ +GRPrinter subclass: GRSequentialPrinter [ + | parts | + + + + + initialize [ + + super initialize. + parts := OrderedCollection new + ] + + , aConverter [ + + parts add: aConverter + ] + + print: anObject on: aStream [ + + parts do: [:each | each print: anObject on: aStream] + ] +] diff --git a/grease/Core/Text/GRSignPrinter.st b/grease/Core/Text/GRSignPrinter.st new file mode 100644 index 0000000..50cbf9a --- /dev/null +++ b/grease/Core/Text/GRSignPrinter.st @@ -0,0 +1,35 @@ +GRPrinter subclass: GRSignPrinter [ + | negativePrinter positivePrinter | + + + + + negativePrinter: aPrinter [ + "The printer to be used when the number is negative." + + + negativePrinter := aPrinter + ] + + positivePrinter: aPrinter [ + "The printer to be used when the number is zero or positive." + + + positivePrinter := aPrinter + ] + + initialize [ + + super initialize. + self negativePrinter: $-. + self positivePrinter: nil + ] + + print: anObject on: aStream [ + + anObject negative + ifTrue: [negativePrinter print: anObject on: aStream] + ifFalse: [positivePrinter print: anObject on: aStream] + ] +] + diff --git a/grease/Core/Text/GRStringPrinter.st b/grease/Core/Text/GRStringPrinter.st new file mode 100644 index 0000000..4433ed6 --- /dev/null +++ b/grease/Core/Text/GRStringPrinter.st @@ -0,0 +1,106 @@ +GRPrinter subclass: GRStringPrinter [ + | trim length pad character | + + + + + character: aCharacter [ + "The character to pad the string with." + + + character := aCharacter + ] + + length: anInteger [ + "The maximal size of the string, or the size to pad to." + + + length := anInteger + ] + + initialize [ + + super initialize. + self + character: $ ; + length: nil. + self + trimNone; + padNone + ] + + padCenter [ + "Pad to the center." + + + pad := #pad:center:to: + ] + + padLeft [ + "Pad to the left." + + + pad := #pad:left:to: + ] + + padNone [ + "Do not pad the input." + + + pad := nil + ] + + padRight [ + "Pad to the right." + + + pad := #pad:right:to: + ] + + print: anObject on: aStream [ + + | 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." + + + trim := #trimBoth + ] + + trimLeft [ + "Trim to the left and to the right." + + + trim := #trimLeft + ] + + trimNone [ + "Do not trim the input." + + + trim := nil + ] + + trimRight [ + "Trim to the left and to the right." + + + trim := #trimRight + ] +] + diff --git a/grease/Core/Text/GRUnitPrinter.st b/grease/Core/Text/GRUnitPrinter.st new file mode 100644 index 0000000..08d1b3f --- /dev/null +++ b/grease/Core/Text/GRUnitPrinter.st @@ -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 | + + + + + GRUnitPrinter class >> base: anInteger units: anArray [ + + ^(self new) + base: anInteger; + units: anArray; + yourself + ] + + base: anInteger [ + + base := anInteger + ] + + fractionPrinter: aPrinter [ + + fractionPrinter := aPrinter + ] + + integerPrinter: aPrinter [ + + integerPrinter := aPrinter + ] + + units: anArray [ + + units := anArray + ] + + initialize [ + + super initialize. + self integerPrinter: ((GRNumberPrinter new) + precision: 0; + yourself). + self fractionPrinter: ((GRNumberPrinter new) + precision: 1; + yourself) + ] + + print: anObject on: aStream [ + + 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 [ + + (units first = aString or: [units second = aString]) + ifTrue: [integerPrinter print: aNumber on: aStream] + ifFalse: [fractionPrinter print: aNumber on: aStream]. + aStream + nextPut: $ ; + nextPutAll: aString + ] +] + diff --git a/grease/Core/Text/GRUnsupportedEncodingError.st b/grease/Core/Text/GRUnsupportedEncodingError.st new file mode 100644 index 0000000..fc53019 --- /dev/null +++ b/grease/Core/Text/GRUnsupportedEncodingError.st @@ -0,0 +1,6 @@ +GRError subclass: GRUnsupportedEncodingError [ + + + +] + diff --git a/grease/Core/Utilities/GRBoundDelayedSend.st b/grease/Core/Utilities/GRBoundDelayedSend.st new file mode 100644 index 0000000..e1b882f --- /dev/null +++ b/grease/Core/Utilities/GRBoundDelayedSend.st @@ -0,0 +1,48 @@ +GRDelayedSend subclass: GRBoundDelayedSend [ + | arguments | + + + + arguments + - the predefined arguments'> + + + argumentCount [ + + ^selector numArgs - arguments size + ] + + valueWithArguments: anArray [ + + ^arguments size + anArray size = selector numArgs + ifTrue: [receiver perform: selector withArguments: arguments , anArray] + ifFalse: [self invalidArgumentCount] + ] + + valueWithPossibleArguments: anArray [ + + | 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 [ + + self initializeWithReceiver: anObject selector: aSymbol. + arguments := anArray asArray + ] + + printOn: aStream [ + + super printOn: aStream. + aStream + nextPutAll: ' arguments: '; + print: arguments + ] +] diff --git a/grease/Core/Utilities/GRDelayedSend.st b/grease/Core/Utilities/GRDelayedSend.st new file mode 100644 index 0000000..e16796e --- /dev/null +++ b/grease/Core/Utilities/GRDelayedSend.st @@ -0,0 +1,104 @@ +GRObject subclass: GRDelayedSend [ + | receiver selector | + + + selector: + + receiver + - the object receiving the message + + selector + - the message selector sent to the receiver'> + + + GRDelayedSend class >> receiver: anObject selector: aSymbol [ + + ^GRUnboundDelayedSend basicNew initializeWithReceiver: anObject + selector: aSymbol + ] + + GRDelayedSend class >> receiver: anObject selector: aSymbol argument: aParameter [ + + ^self + receiver: anObject + selector: aSymbol + arguments: (Array with: aParameter) + ] + + GRDelayedSend class >> receiver: anObject selector: aSymbol arguments: anArray [ + + ^GRBoundDelayedSend basicNew + initializeWithReceiver: anObject + selector: aSymbol + arguments: anArray + ] + + argumentCount [ + "Answer the number of arguments that must be provided to the receiver when sending it." + + + self subclassResponsibility + ] + + fixCallbackTemps [ + "For polymorphism with BlockContext>>#fixCallbackTemps." + + + + ] + + value [ + + ^self valueWithArguments: #() + ] + + value: anObject [ + + ^self valueWithArguments: (Array with: anObject) + ] + + value: aFirstObject value: aSecondObject [ + + ^self valueWithArguments: (Array with: aFirstObject with: aSecondObject) + ] + + valueWithArguments: anArray [ + + self subclassResponsibility + ] + + valueWithPossibleArguments: anArray [ + + self subclassResponsibility + ] + + initializeWithReceiver: anObject selector: aSymbol [ + + self initialize. + receiver := anObject. + selector := aSymbol + ] + + printOn: aStream [ + + super printOn: aStream. + aStream + nextPutAll: ' receiver: '; + print: receiver. + aStream + nextPutAll: ' selector: '; + print: selector + ] + + invalidArgumentCount [ + + GRInvalidArgumentCount signal + ] +] diff --git a/grease/Core/Utilities/GRInvalidArgumentCount.st b/grease/Core/Utilities/GRInvalidArgumentCount.st new file mode 100644 index 0000000..8129bb3 --- /dev/null +++ b/grease/Core/Utilities/GRInvalidArgumentCount.st @@ -0,0 +1,6 @@ +GRError subclass: GRInvalidArgumentCount [ + + + +] + diff --git a/grease/Core/Utilities/GRUnboundDelayedSend.st b/grease/Core/Utilities/GRUnboundDelayedSend.st new file mode 100644 index 0000000..470c095 --- /dev/null +++ b/grease/Core/Utilities/GRUnboundDelayedSend.st @@ -0,0 +1,25 @@ +GRDelayedSend subclass: GRUnboundDelayedSend [ + + + + + argumentCount [ + + ^selector numArgs + ] + + valueWithArguments: anArray [ + + ^anArray size = selector numArgs + ifTrue: [receiver perform: selector withArguments: anArray] + ifFalse: [self invalidArgumentCount] + ] + + valueWithPossibleArguments: anArray [ + + ^anArray size < selector numArgs + ifTrue: [self invalidArgumentCount] + ifFalse: [self valueWithArguments: (anArray first: selector numArgs)] + ] +] + diff --git a/grease/GST/Core/Extensions.st b/grease/GST/Core/Extensions.st new file mode 100644 index 0000000..c87e953 --- /dev/null +++ b/grease/GST/Core/Extensions.st @@ -0,0 +1,394 @@ +GRPackage class extend [ + + greaseGSTCore [ + + ^(self new) + name: 'Grease-GST-Core'; + addDependency: 'Grease-Core'; + url: #gstUrl; + yourself + ] + + greaseTestsGSTCore [ + + ^(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 [ + + ^'http://git.savannah.gnu.org/r/smalltalk.git/' + ] +] + +Object extend [ + + isEmptyOrNil [ + + ^false + ] +] + +Collection extend [ + + isEmptyOrNil [ + + ^self isEmpty + ] +] + +Interval extend [ + +] + +UndefinedObject extend [ + + isEmptyOrNil [ + + ^true + ] +] + +BlockClosure extend [ + + fixCallbackTemps [ + + ] +] + +Behavior extend [ + + fullName [ + + ^self nameIn: Smalltalk + ] + + startUp: aBoolean [ + "StartUo/ShutDown. See GRGSTPlatform class methods about startUpList and shutDownList" + + ] + + shutDown: aBoolean [ + "StartUo/ShutDown. See GRGSTPlatform class methods about startUpList and shutDownList" + + ] +] + +Time class extend [ + + totalSeconds [ + + ^self secondClock + ] +] + +Date class extend [ + + year: y month: m day: d [ + + ^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 [ + + self + nextPut: Character cr; + nextPut: Character lf + ] +] + +Random extend [ + + nextInt: anInteger [ + + anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ]. + ^(self next * anInteger) truncated + 1 + ] + +] + +DirectedMessage extend [ + + valueWithPossibleArguments: anArray [ + + | 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 [ + + ^self numArgs + ] + + valueWithPossibleArguments: aCollection [ + + | 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 [ + + ^self asString capitalized asSymbol + ] + + isKeyword [ + + ^self last = $: + ] + + isUnary [ + + ^self isKeyword not and: [ + self first isLetter] + ] + + asMutator [ + + "Return a setter message from a getter message. For example, + #name asMutator returns #name:" + ^ (self copyWith: $:) asSymbol + ] +] + +String extend [ + + reversed [ + + ^self reverse + ] + + beginsWith: aString [ + + ^self startsWith: aString + ] + + sort [ + + self sort: [:a :b | a <= b] + ] + + sort: aBlock [ + + self + replaceFrom: 1 + to: self size + with: (self asSortedCollection: aBlock) asString + startingAt: 1 + ] + + capitalized [ + + | cap | + self isEmpty ifTrue: [^self]. + cap := self copy. + cap at: 1 put: (self at: 1) asUppercase. + ^cap + ] +] + +Character extend [ + + greaseInteger [ + + ^self codePoint + ] + + asUnicode [ + + ^self codePoint + ] +] + +CharacterArray extend [ + + greaseString [ + + ^self asString + ] +] + +Number extend [ + + isFraction [ + + ^false + ] + + weeks [ + + ^Duration weeks: self + ] + + days [ + + ^Duration days: self + ] + + hours [ + + ^Duration hours: self + ] + + minutes [ + + ^Duration minutes: self + ] + + seconds [ + + ^Duration seconds: self + ] + + milliseconds [ + + ^Duration milliseconds: self + ] + + isZero [ + + ^self = 0 + ] +] + +Float class extend [ + + nan [ + + "Why a FloatD?" + ^FloatD nan + ] + + infinity [ + + "Why a FloatD?" + ^FloatD infinity + ] +] + +Collection extend [ + + any [ + + ^self anyOne + ] + + sorted [ + + ^self asArray sort + ] + + sorted: aBlock [ + + ^self asArray sort: aBlock + ] + + isCollection [ + + ^true + ] +] + +Object extend [ + printStringLimitedTo: anInteger [ + "Answer a String representing the receiver, without making it longer + than anInteger characters" + + + | 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 [ + + ^0 + ] +] + +BlockClosure extend [ + fixCallbackTemps [ + + outerContext isNil ifTrue: [^self]. + ^self shallowCopy outerContext: outerContext fixCallbackTemps; yourself + ] +] + +BlockContext extend [ + fixCallbackTemps [ + + outerContext isNil ifTrue: [^self shallowCopy]. + ^self shallowCopy outerContext: outerContext fixCallbackTemps; yourself + ] +] + +ContextPart extend [ + fixCallbackTemps [ + + ^self shallowCopy + ] +] + +DirectedMessage extend [ + argumentCount [ + "Answer the number of missing arguments to complete the number required + by the receiver's selector" + + + ^self selector numArgs - self arguments size + ] + + fixCallbackTemps [ + + ^self + ] +] diff --git a/grease/GST/Core/GRGSTGenericCodec.st b/grease/GST/Core/GRGSTGenericCodec.st new file mode 100644 index 0000000..fd6d60a --- /dev/null +++ b/grease/GST/Core/GRGSTGenericCodec.st @@ -0,0 +1,86 @@ +GRCodec subclass: GRGSTGenericCodec [ + | encoding urlCodec | + + + + + GRGSTGenericCodec class [ + + basicForEncoding: aString [ + + (self supportsEncoding: aString) + ifFalse: [self unsupportedEncoding: aString]. + ^self basicNew initializeWithEncoding: aString + ] + + supportedEncodingNames [ + "answers the names of the encodings supported by this class" + + + ^#('UTF-8') + ] + + codecs [ + + ^self supportedEncodingNames collect: [:each | + self basicForEncoding: each] + ] + + supportsEncoding: aString [ + "Answer whether the the given encoding name is supported." + + + ^true + "^self supportedEncodingNames includes: aString" + ] +] + + + decoderFor: aStream [ + + ^(I18N.EncodedStream unicodeOn: aStream encoding: encoding) + ] + + encoderFor: aStream [ + + 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 [ + + ^(self decoderFor: aString readStream) contents + ] + + encode: aString [ + + ^(self encoderFor: aString readStream) contents asString + ] + + initializeWithEncoding: aString [ + + self initialize. + encoding := aString. + urlCodec := self + ] + + name [ + + ^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." + + + ^urlCodec + ] +] + diff --git a/grease/GST/Core/GRGSTPlatform.st b/grease/GST/Core/GRGSTPlatform.st new file mode 100644 index 0000000..8d28cd5 --- /dev/null +++ b/grease/GST/Core/GRGSTPlatform.st @@ -0,0 +1,326 @@ +GRPlatform subclass: GRGSTPlatform [ + + + + + GRGSTPlatform class [ + | startUpList shutdownList | + + initialize [ + + startUpList := OrderedCollection new. + shutdownList := OrderedCollection new. + self select + ] + + unload [ + + self unselect + ] + + update: anAspect [ + + anAspect == #returnFromSnapshot ifTrue: [ + startUpList do: [:each | each startUp: true]]. + anAspect == #aboutToQuit ifTrue: [ + shutdownList do: [:each | each shutDown: true]] + ] + + addToStartUpList: anObject [ + + (startUpList includes: anObject) ifFalse: [ + startUpList add: anObject] + ] + + addToShutDownList: anObject [ + + (shutdownList includes: anObject) ifFalse: [ + shutdownList add: anObject] + ] + + removeFromStartUpList: anObject [ + + (startUpList includes: anObject) ifTrue: [ + startUpList remove: anObject] + ] + + removeFromShutDownList: anObject [ + + (shutdownList includes: anObject) ifTrue: [ + shutdownList remove: anObject] + ] + ] + + newline [ + "Answer the system's default newline character (sequence)." + + + ^' +' + ] + + addToShutDownList: anObject [ + "Add anObject to the shutdown-list of the system. On shutdown the + message #shutDown will be sent to anObject." + + + 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." + + + self class addToStartUpList: anObject + ] + + removeFromShutDownList: anObject [ + "Remove anObject from the shutdown list in the system." + + + self class removeFromShutDownList: anObject + ] + + removeFromStartUpList: anObject [ + "Remove anObject from the startup list in the system." + + + self class removeFromStartUpList: anObject + ] + + asMethodReturningByteArray: aByteArrayOrString named: aSymbol [ + "Generates the source of a method named aSymbol that returns + aByteArrayOrString as a ByteArray" + + + ^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 [ + + aClass compile: aString classified: aSymbol + ] + + contentsOfFile: aString binary: aBoolean [ + + | data | + data := (File name: aString) contents. + aBoolean ifTrue: [ data := data asByteArray ]. + ^data + ] + + convertToSmalltalkNewlines: aString [ + "Convert any line endings (CR, CRLF, LF) to CR." + + + 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" + + + (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 ." + + + | directory | + directory := File name: aPathString. + ^(directory files + reject: [:each | each name first = $.]) + collect: [:each | each asString] + ] + + localNameOf: aFilename [ + + ^File stripPathFrom: aFilename + ] + + removeSelector: aSymbol from: aClass [ + + aClass removeSelector: aSymbol + ] + + write: aStringOrByteArray toFile: aFileNameString inFolder: aFolderString [ + "writes aStringOrByteArray to a file named aFilenameString in the folder aFolderString" + + + | stream fileName | + aFolderString / aFileNameString withWriteStreamDo: [ :stream | + stream nextPutAll: aStringOrByteArray ] + ] + + base64Decode: aString [ + + | 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." + + + ^aProcess isTerminated + ] + + terminateProcess: aProcess [ + "Permanently terminate the process, unwinding first to execute #ensure: + and #ifCurtailed: blocks." + + + aProcess terminate + ] + + label [ + + ^'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." + + + ^GRGSTRandomProvider + ] + + readWriteByteStream [ + "ByteArray based read write stream" + + + ^ReadWriteStream on: ByteArray new + ] + + readWriteCharacterStream [ + "String based read write stream" + + + ^ReadWriteStream on: '' + ] + + semaphoreClass [ + "used by Gemstone/S traditional Semaphores which cannot be persisted" + + + ^Semaphore + ] + + weakDictionaryOfSize: aNumber [ + + ^WeakKeyIdentityDictionary new: aNumber + ] + + openDebuggerOn: anError [ + + | 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 [ + + | depth current | + depth := 0. + current := thisContext. + [current isNil] whileFalse: + [current := current parentContext. + depth := depth + 1]. + ^depth - 1 + ] + + secureHashFor: aString [ + + ^MD5 digestOf: aString + ] +] + + + +Eval [ + GRGSTPlatform initialize +] + diff --git a/grease/GST/Core/GRGSTRandomProvider.st b/grease/GST/Core/GRGSTRandomProvider.st new file mode 100644 index 0000000..fcc5d61 --- /dev/null +++ b/grease/GST/Core/GRGSTRandomProvider.st @@ -0,0 +1,60 @@ +GRObject subclass: GRGSTRandomProvider [ + + + + + GRGSTRandomProvider class [ + | mutex generator | + + ] + + GRGSTRandomProvider class >> initialize [ + + GRPlatform current addToStartUpList: self. + self startUp + ] + + GRGSTRandomProvider class >> randomClass [ + + ^Random + ] + + GRGSTRandomProvider class >> unload [ + + GRPlatform current removeFromStartUpList: self + ] + + GRGSTRandomProvider class >> nextInt: anInteger [ + "Answer a random integer in the interval [1, anInteger]" + + + ^mutex critical: [generator nextInt: anInteger] + ] + + GRGSTRandomProvider class >> randomFrom: aCollection [ + + | 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 [ + + generator := self randomClass new. + mutex := Semaphore forMutualExclusion + ] +] + + + +Eval [ + GRGSTRandomProvider initialize +] + diff --git a/grease/PORTING b/grease/PORTING new file mode 100644 index 0000000..b3a8b6a --- /dev/null +++ b/grease/PORTING @@ -0,0 +1,4 @@ +Grease-Core-obi.30 +Grease-Pharo-Core-pmm.13 +Grease-Tests-Core-pmm.39 +Grease-Tests-Pharo-Core-lr.6 diff --git a/grease/PackageBuilder.st b/grease/PackageBuilder.st new file mode 100755 index 0000000..a926ad1 --- /dev/null +++ b/grease/PackageBuilder.st @@ -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 [ + + |stream indent indentString| + + Indenter class >> on: aStream [ + + + ^ self new on: aStream + ] + + on: aStream [ + + + stream := aStream. + indent := ''. + indentString := ' ' + ] + + indent [ + + + stream nextPutAll: indent + ] + + indentMore [ + + + indent := indent , indentString + ] + + indentLess [ + + + ( indent size < indentString size ) + ifTrue: [ indent := '' ] + ifFalse: [ + indent := indent allButLast: indentString size + ] + ] + + nextPutAll: aString [ + + stream nextPutAll: aString + ] + + nextPut: aChar [ + + stream nextPut: aChar + ] + + tag: aString [ + + to stream.'> + stream nextPut: $<; nextPutAll: aString; nextPut: $> + ] + + indentNl: aBlock [ + + + self indent. + aBlock cull: stream. + stream nl + ] + + wrap: aString do: aBlock [ + + + self indentNl: [ self tag: aString ]. + self indentMore. + aBlock value. + self indentLess. + self indentNl: [ self tag: '/',aString ]. + ] + + wrap: aString around: contentString [ + + + contentString ifNotNil: [ + self indentNl: [ :aStream | + self + tag: aString; + nextPutAll: contentString; + tag: '/',aString]] + ] + + wrap: aString aroundEachOf: aCollection [ + + + aCollection do: [ :item | self wrap: aString around: item ] + ] +] + + +Object subclass: TestBuilder [ + + | testroot pattern namespace | + + testroot [ + + ^ testroot + ] + testroot: aString [ + + testroot := File name: aString + ] + pattern [ + + ^ pattern + ] + pattern: aString [ + + pattern := aString + ] + namespace [ + + ^ namespace + ] + namespace: aString [ + + namespace := aString + ] + + collectFiles [ + + + |files| + files := OrderedCollection new. + ( self testroot ) allFilesMatching: self pattern do: [ :f | + files add: f + ]. + ^ files + ] + + collectTestsIn: aCollection [ + + + |tests| + tests := OrderedCollection new. + aCollection do: [ :file | + file contents onOccurrencesOfRegex: 'subclass: (.*Test)' do: [ :rr | + tests add: ( rr at: 1 ) + ] + ]. + ^ tests + ] + + renderTests: aCollection on: aStream [ + + + aStream wrap: 'sunit' do: [ + aCollection do: [ :tc | + aStream indentNl: [ + aStream + nextPutAll: self namespace; + nextPut: $.; + nextPutAll: tc + ] + ] + ] + ] + + renderXmlOn: 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 [ + + ^ name + ] + name: aString [ + + name := aString + ] + url [ + + ^ url + ] + url: aString [ + + url := aString + ] + namespace [ + + ^ namespace + ] + namespace: aString [ + + namespace := aString + ] + prereqs [ + + ^ prereqs + ] + prereq: aString [ + + prereqs add: aString + ] + provides [ + + ^ provides + ] + provides: aString [ + + provides add: aString + ] + start [ + + ^ start + ] + start: aString [ + + start := aString + ] + fileins [ + + ^ fileins + ] + filein: aString [ + + fileins add: aString + ] + + resource: aString [ + + resources add: aString + ] + + testsBelow: aDirname matching: aPattern [ + + + testBuilder := + TestBuilder new + testroot: aDirname; + pattern: aPattern; + namespace: self namespace. + ] + + renderXmlOn: aStream [ + + + 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 [ + + + self renderXmlOn: ( Indenter on: FileStream stdout ) + ] + +] + + +Eval [ + Smalltalk arguments do: [ :filename | FileStream fileIn: filename ] +] diff --git a/grease/README b/grease/README new file mode 100644 index 0000000..e69de29 diff --git a/grease/Tests/Core/GRAbstractDictionaryTest.st b/grease/Tests/Core/GRAbstractDictionaryTest.st new file mode 100644 index 0000000..f5691be --- /dev/null +++ b/grease/Tests/Core/GRAbstractDictionaryTest.st @@ -0,0 +1,85 @@ +GRCollectionTest subclass: GRAbstractDictionaryTest [ + | associations | + + + + + GRAbstractDictionaryTest class >> isAbstract [ + + ^self name = #GRAbstractDictionaryTest + ] + + allowsDuplicateValues [ + + ^true + ] + + arbitraryAssociations [ + + ^associations ifNil: [associations := self createArbitraryAssociations] + ] + + arbitraryCollection [ + + | dict | + dict := self emptyCollection. + self arbitraryAssociations do: [:each | dict at: each key put: each value]. + ^dict + ] + + createArbitraryAssociations [ + + self subclassResponsibility + ] + + isKey: anObject equivalentTo: anotherObject [ + + self subclassResponsibility + ] + + isExtensible [ + + ^false + ] + + isInitializable [ + + ^false + ] + + isSequenced [ + + ^false + ] + + isSequencedReadable [ + + ^false + ] + + testAssociationsDo [ + + | 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 [ + + ^aCollection values + ] +] + diff --git a/grease/Tests/Core/GRArrayTest.st b/grease/Tests/Core/GRArrayTest.st new file mode 100644 index 0000000..6e2dc06 --- /dev/null +++ b/grease/Tests/Core/GRArrayTest.st @@ -0,0 +1,36 @@ +GRCollectionTest subclass: GRArrayTest [ + + + + + allowsDuplicateValues [ + + ^true + ] + + collectionClass [ + + ^Array + ] + + isExtensible [ + + ^false + ] + + isInitializable [ + + ^true + ] + + isSequenced [ + + ^true + ] + + isSequencedReadable [ + + ^true + ] +] + diff --git a/grease/Tests/Core/GRBagTest.st b/grease/Tests/Core/GRBagTest.st new file mode 100644 index 0000000..c729810 --- /dev/null +++ b/grease/Tests/Core/GRBagTest.st @@ -0,0 +1,36 @@ +GRCollectionTest subclass: GRBagTest [ + + + + + allowsDuplicateValues [ + + ^true + ] + + collectionClass [ + + ^Bag + ] + + isExtensible [ + + ^true + ] + + isInitializable [ + + ^true + ] + + isSequenced [ + + ^false + ] + + isSequencedReadable [ + + ^false + ] +] + diff --git a/grease/Tests/Core/GRCodecTest.st b/grease/Tests/Core/GRCodecTest.st new file mode 100644 index 0000000..8b81d7c --- /dev/null +++ b/grease/Tests/Core/GRCodecTest.st @@ -0,0 +1,122 @@ +TestCase subclass: GRCodecTest [ + + + + + decodedString [ + + ^'Übèrstrîñgé' + ] + + latin1String [ + + ^self + asString: #(220 98 232 114 115 116 114 238 241 103 233) + ] + + macromanString [ + + ^self + asString: #(134 98 143 114 115 116 114 148 150 103 142) + ] + + utf16beString [ + + ^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 [ + + ^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 [ + + ^self + asString: #(195 156 98 195 168 114 115 116 114 195 174 195 177 103 195 169) + ] + + testAllCodecs [ + + self assert: GRCodec allCodecs notEmpty. + GRCodec allCodecs do: + [:codec | + self deny: codec class = GRCodec. + self assert: (codec isKindOf: GRCodec)] + ] + + testCodecLatin1 [ + + #('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 [ + + #('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 [ + + | 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 [ + + ^String streamContents: + [:stream | + aCollectionOfIntegers + do: [:each | stream nextPut: (Character value: each)]] + ] + + seasideByteArray [ + + ^#(83 101 97 115 105 100 101) asByteArray "Seaside" + ] +] diff --git a/grease/Tests/Core/GRCollectionTest.st b/grease/Tests/Core/GRCollectionTest.st new file mode 100644 index 0000000..550fea7 --- /dev/null +++ b/grease/Tests/Core/GRCollectionTest.st @@ -0,0 +1,291 @@ +TestCase subclass: GRCollectionTest [ + + + + + GRCollectionTest class >> isAbstract [ + + ^self name = #GRCollectionTest + ] + + allowsDuplicateValues [ + "Does the tested collection allow storage of duplicate (equal) values." + + + self subclassResponsibility + ] + + arbitraryCollection [ + "An general collection for testing. It should meet the needs of #duplicateElement, + #excludedElement, #includedElement, and so on where appropriate." + + + ^self collectionClass withAll: #(3 1 2 1 4) + ] + + collectionClass [ + "Answer the collection class that is being tested." + + + self subclassResponsibility + ] + + duplicateElement [ + "Answer an element that appears multiple times in #arbitraryCollection." + + + ^1 + ] + + emptyCollection [ + "Answer an empty collection." + + + ^self collectionClass new + ] + + excludedElement [ + "Answer an element that does not appear in #arbitraryCollection." + + + ^19 + ] + + includedElement [ + "Answer a (non-duplicate) element that does appear in #arbitraryCollection." + + + ^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 + ^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." + + + 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." + + + self deny: responseCollection == receiverCollection. + self + assert: (self isValidNewSequencedResponseClass: responseCollection class) + ] + + isExtensible [ + "Answer whether the tested Collection implements the + protocol as defined in ANSI 5.7.5 ." + + + self subclassResponsibility + ] + + isInitializable [ + "Answer whether the tested Collection implements the + protocol as defined in ANSI 5.7.23." + + + self subclassResponsibility + ] + + isSequenced [ + "Answer whether the tested Collection implements the + protocol as defined in ANSI 5.7.12." + + + self subclassResponsibility + ] + + isSequencedReadable [ + "Answer whether the tested Collection implements the + protocol as defined in ANSI 5.7.8." + + + self subclassResponsibility + ] + + testAddFirst [ + + | 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 [ + + | collection | + collection := self arbitraryCollection. + self assert: ((self valuesOf: collection) includes: collection any) + ] + + testCopyUpTo [ + + | 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 [ + + | 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 [ + + | collection | + collection := self emptyCollection. + self should: [(self valuesOf: collection) includes: collection any] + raise: Error + ] + + testIsCollection [ + + self assert: self arbitraryCollection isCollection + ] + + testNoneSatisfy [ + + | 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 [ + + self assert: self arbitraryCollection notEmpty. + self deny: self emptyCollection notEmpty. + self assert: self arbitraryCollection notEmpty. + self deny: self emptyCollection notEmpty + ] + + testSort [ + + | 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 [ + + | 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." + + + ^aCollection + ] +] + diff --git a/grease/Tests/Core/GRDelayedSendTest.st b/grease/Tests/Core/GRDelayedSendTest.st new file mode 100644 index 0000000..45d2125 --- /dev/null +++ b/grease/Tests/Core/GRDelayedSendTest.st @@ -0,0 +1,322 @@ +TestCase subclass: GRDelayedSendTest [ + + + + + testArgumentCount [ + "unary" + + + | 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 [ + + | send | + send := GRDelayedSend receiver: 1 selector: #+. + self assert: send fixCallbackTemps == send. + send := GRDelayedSend + receiver: 1 + selector: #+ + argument: 2. + self assert: send fixCallbackTemps == send + ] + + testValueBinary [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 + ] +] + diff --git a/grease/Tests/Core/GRDictionaryTest.st b/grease/Tests/Core/GRDictionaryTest.st new file mode 100644 index 0000000..9ae6996 --- /dev/null +++ b/grease/Tests/Core/GRDictionaryTest.st @@ -0,0 +1,27 @@ +GRAbstractDictionaryTest subclass: GRDictionaryTest [ + + + + + collectionClass [ + + ^Dictionary + ] + + createArbitraryAssociations [ + + ^(OrderedCollection new) + add: #c -> 3; + add: #a -> 1; + add: #b -> 2; + add: #e -> 1; + add: #d -> 4; + yourself + ] + + isKey: anObject equivalentTo: anotherObject [ + + ^anObject = anotherObject + ] +] + diff --git a/grease/Tests/Core/GRDurationTest.st b/grease/Tests/Core/GRDurationTest.st new file mode 100644 index 0000000..f72f607 --- /dev/null +++ b/grease/Tests/Core/GRDurationTest.st @@ -0,0 +1,133 @@ +TestCase subclass: GRDurationTest [ + + + + + testAccessors [ + + | 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 [ + + 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 [ + + | 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 [ + + self + assert: (Duration + days: 1 + hours: -23 + minutes: 1 + seconds: -59) asMilliseconds + = 3601000 + ] + + testNegativeInstanceCreation [ + + 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." + + + 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 [ + + 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 [ + + | duration | + duration := Duration zero. + self assert: duration isZero. + self assert: duration asMilliseconds = 0. + self assert: duration = (Duration seconds: 0) + ] + + testIntegerConvenienceMethods [ + + 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) + ] +] + diff --git a/grease/Tests/Core/GRErrorStub.st b/grease/Tests/Core/GRErrorStub.st new file mode 100644 index 0000000..51ed5e2 --- /dev/null +++ b/grease/Tests/Core/GRErrorStub.st @@ -0,0 +1,17 @@ +GRError subclass: GRErrorStub [ + | foo | + + + + + initialize [ + + super initialize. + foo := true + ] + + foo [ + + ^foo + ] +] diff --git a/grease/Tests/Core/GRExceptionTest.st b/grease/Tests/Core/GRExceptionTest.st new file mode 100644 index 0000000..2e93d63 --- /dev/null +++ b/grease/Tests/Core/GRExceptionTest.st @@ -0,0 +1,207 @@ +TestCase subclass: GRExceptionTest [ + + + + + 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." + + + | result | + result := GRNotificationStub signal. + self assert: result = #returnValue + ] + + testDeprecatedApi [ + + | 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." + + + 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." + + + | 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." + + + 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." + + + | 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." + + + 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." + + + [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." + + + [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." + + + [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." + + + [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." + + + | 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." + + + | 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." + + + | 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." + + + | text | + text := 'Notification'. + [GRNotification signal: text] on: GRNotification + do: + [:e | + self assert: e messageText = text. + ^self]. + self assert: false + ] + + onExceptionReturn: anObject [ + + [GRError signal] on: GRError do: [:ex | ^anObject]. + ^self + ] +] + diff --git a/grease/Tests/Core/GRIdentityDictionaryTest.st b/grease/Tests/Core/GRIdentityDictionaryTest.st new file mode 100644 index 0000000..795fb67 --- /dev/null +++ b/grease/Tests/Core/GRIdentityDictionaryTest.st @@ -0,0 +1,27 @@ +GRAbstractDictionaryTest subclass: GRIdentityDictionaryTest [ + + + + + collectionClass [ + + ^IdentityDictionary + ] + + createArbitraryAssociations [ + + ^(OrderedCollection new) + add: 'c' -> 3; + add: 'a' -> 1; + add: 'b' -> 2; + add: 'd' -> 1; + add: 'b' copy -> 4; + yourself + ] + + isKey: anObject equivalentTo: anotherObject [ + + ^anObject == anotherObject + ] +] + diff --git a/grease/Tests/Core/GRIntervalTest.st b/grease/Tests/Core/GRIntervalTest.st new file mode 100644 index 0000000..43ee55b --- /dev/null +++ b/grease/Tests/Core/GRIntervalTest.st @@ -0,0 +1,52 @@ +GRCollectionTest subclass: GRIntervalTest [ + + + + + allowsDuplicateValues [ + + ^false + ] + + arbitraryCollection [ + + ^1 to: 4 + ] + + collectionClass [ + + ^Interval + ] + + emptyCollection [ + + ^1 to: 0 + ] + + isValidNewSequencedResponseClass: aClass [ + + ^aClass == SequenceableCollection + or: [aClass allSuperclasses includes: SequenceableCollection] + ] + + isExtensible [ + + ^false + ] + + isInitializable [ + + ^false + ] + + isSequenced [ + + ^false + ] + + isSequencedReadable [ + + ^true + ] +] + diff --git a/grease/Tests/Core/GRNotificationStub.st b/grease/Tests/Core/GRNotificationStub.st new file mode 100644 index 0000000..87ef9ca --- /dev/null +++ b/grease/Tests/Core/GRNotificationStub.st @@ -0,0 +1,23 @@ +GRNotification subclass: GRNotificationStub [ + | foo | + + + + + defaultAction [ + + ^#returnValue + ] + + foo [ + + ^foo + ] + + initialize [ + + super initialize. + foo := true + ] +] + diff --git a/grease/Tests/Core/GRNullCodecStreamTest.st b/grease/Tests/Core/GRNullCodecStreamTest.st new file mode 100644 index 0000000..8b1098a --- /dev/null +++ b/grease/Tests/Core/GRNullCodecStreamTest.st @@ -0,0 +1,100 @@ +TestCase subclass: GRNullCodecStreamTest [ + + + + + codecStreamClass [ + + ^GRNullCodecStream + ] + + seasideByteArray [ + + ^#(83 101 97 115 105 100 101) asByteArray "Seaside" + ] + + testCrlf [ + + | 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 [ + + | 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 [ + + | 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 [ + + | stream | + stream := GRNullCodec new encoderFor: (WriteStream on: String new). + stream nextPutAll: 'abc'. + self shouldnt: [stream flush] raise: Error. + self assert: stream contents = 'abc' + ] + + testNext [ + + | stream | + stream := GRNullCodec new encoderFor: 'Seaside' readStream. + self assert: stream next = $S. + self assert: (stream next: 1) = 'e' + ] + + testSize [ + + | 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 [ + + | stream | + stream := GRNullCodec new encoderFor: (WriteStream on: String new). + self shouldnt: [stream text] raise: Error + ] + + testReadString [ + + | stream codecStream | + stream := 'abc' readStream. + codecStream := GRNullCodec new decoderFor: stream. + self assert: codecStream next = $a. + self assert: (codecStream next: 2) = 'bc' + ] + + testWriteString [ + + | 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' + ] +] + diff --git a/grease/Tests/Core/GRNumberTest.st b/grease/Tests/Core/GRNumberTest.st new file mode 100644 index 0000000..11a34a1 --- /dev/null +++ b/grease/Tests/Core/GRNumberTest.st @@ -0,0 +1,107 @@ +TestCase subclass: GRNumberTest [ + + + + + testBetweenAnd [ + + self assert: (6 between: 1 and: 12) + ] + + testPluralize [ + + 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" + + + 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 [ + + | 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 [ + + | 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." + + + | 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) + ] +] + diff --git a/grease/Tests/Core/GRObjectStub.st b/grease/Tests/Core/GRObjectStub.st new file mode 100644 index 0000000..e1dad62 --- /dev/null +++ b/grease/Tests/Core/GRObjectStub.st @@ -0,0 +1,18 @@ +GRObject subclass: GRObjectStub [ + | foo | + + + + + foo [ + + ^foo + ] + + initialize [ + + super initialize. + foo := true + ] +] + diff --git a/grease/Tests/Core/GRObjectTest.st b/grease/Tests/Core/GRObjectTest.st new file mode 100644 index 0000000..df52095 --- /dev/null +++ b/grease/Tests/Core/GRObjectTest.st @@ -0,0 +1,22 @@ +TestCase subclass: GRObjectTest [ + + + + + testError [ + "Make sure #error: signals a subclass of WAPlatformError." + + + 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." + + + self assert: GRObjectStub new foo + ] +] + diff --git a/grease/Tests/Core/GROrderedCollectionTest.st b/grease/Tests/Core/GROrderedCollectionTest.st new file mode 100644 index 0000000..b79dee5 --- /dev/null +++ b/grease/Tests/Core/GROrderedCollectionTest.st @@ -0,0 +1,36 @@ +GRCollectionTest subclass: GROrderedCollectionTest [ + + + + + allowsDuplicateValues [ + + ^true + ] + + collectionClass [ + + ^OrderedCollection + ] + + isExtensible [ + + ^true + ] + + isInitializable [ + + ^true + ] + + isSequenced [ + + ^true + ] + + isSequencedReadable [ + + ^true + ] +] + diff --git a/grease/Tests/Core/GROrderedMultiMapTest.st b/grease/Tests/Core/GROrderedMultiMapTest.st new file mode 100644 index 0000000..e6e72e5 --- /dev/null +++ b/grease/Tests/Core/GROrderedMultiMapTest.st @@ -0,0 +1,44 @@ +GRSmallDictionaryTest subclass: GROrderedMultiMapTest [ + + + + + GROrderedMultiMapTest class >> shouldInheritSelectors [ + + ^true + ] + + allowsDuplicateKeys [ + + ^true + ] + + collectionClass [ + + ^GROrderedMultiMap + ] + + testAllAt [ + + self assert: (collection allAt: '1') = #(). + collection at: '1' add: 'foo'. + collection at: '1' add: 'bar'. + self assert: (collection allAt: '1') = #('foo' 'bar') + ] + + testAllAtIfAbsent [ + + 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 [ + + collection at: '1' add: 'foo'. + collection at: '1' add: 'bar'. + self assertAssociations: (Array with: '1' -> 'foo' with: '1' -> 'bar') + ] +] + diff --git a/grease/Tests/Core/GRPackageTest.st b/grease/Tests/Core/GRPackageTest.st new file mode 100644 index 0000000..081f4f7 --- /dev/null +++ b/grease/Tests/Core/GRPackageTest.st @@ -0,0 +1,92 @@ +TestCase subclass: GRPackageTest [ + | package | + + + + + setUp [ + + super setUp. + package := GRPackage new + ] + + testAllDependencies [ + + | 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 [ + + 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 [ + + self assert: package description isNil. + package description: 'A hopeless pacakge'. + self assert: package description = 'A hopeless pacakge' + ] + + testLicense [ + + self assert: package license = #MIT. + self assert: package isMIT. + package license: #LGPL. + self assert: package license = #LGPL. + self assert: package isLGPL + ] + + testName [ + + self assert: package name isNil. + package name: 'Gimme-Hope'. + self assert: package name = 'Gimme-Hope' + ] + + testUrl [ + + 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 [ + + | 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] + ] +] + diff --git a/grease/Tests/Core/GRPlatformTest.st b/grease/Tests/Core/GRPlatformTest.st new file mode 100644 index 0000000..c5fa9b2 --- /dev/null +++ b/grease/Tests/Core/GRPlatformTest.st @@ -0,0 +1,939 @@ +TestCase subclass: GRPlatformTest [ + + + + + 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." + + + | codec toDecode decoded | + codec := GRCodec forEncoding: 'utf-8'. + toDecode := aCollectionOfIntegers asByteArray. + decoded := codec decode: toDecode. + self assert: decoded size = 1. + ^decoded at: 1 + ] + + platform [ + + ^GRPlatform current + ] + + testAsNumber [ + + self assert: 2007 asNumber = 2007. + self assert: '2007' asNumber = 2007 + ] + + testAsSeconds [ + + | duration | + duration := Duration + days: 1 + hours: 0 + minutes: 0 + seconds: 0. + self assert: duration asSeconds = 86400 + ] + + testBlockContextWithPossibleArguments [ + + | block | + block := [:x | 1 + x]. + self assert: (block valueWithPossibleArguments: (Array with: 2)) = 3. + block := [false not]. + self assert: (block valueWithPossibleArguments: (Array with: 3)) + ] + + testBlockValuableProtocol [ + + 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" + + + self assert: $S asUnicode = 83 + ] + + testCharacterTo [ + + | 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 [ + + | 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 [ + + (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 [ + + '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' with: (0 to: 35) + do: [:each :expected | self assert: each digitValue = expected] + ] + + testEmptyOrNil [ + + 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." + + + | 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)" + + + | 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 [ + + self assert: 2007 greaseInteger = 2007. + self assert: 2007.0 greaseInteger = 2007. + self assert: 2007.1 greaseInteger = 2007. + self assert: 2007.9 greaseInteger = 2007 + ] + + testGreaseIntegerOnString [ + + 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 [ + + 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 [ + + self assert: (nil ifNil: [1]) = 1. + self assert: (1 ifNil: [2]) = 1 + ] + + testIfTrueIfFalse [ + + 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 [ + + self deny: 7 isCharacter. + self assert: $7 isCharacter + ] + + testIsCollection [ + + self deny: Object new isCollection + ] + + testIsKeyword [ + + self deny: #isKeyword isKeyword. + self deny: #+ isKeyword. + self assert: #isKeyword: isKeyword. + self assert: #isKeyword:isKeyword: isKeyword + ] + + testIsUnary [ + + self assert: #isUnary isUnary. + self deny: #+ isUnary. + self deny: #isUnary: isUnary. + self deny: #isUnary:isUnary: isUnary + ] + + testLabel [ + + self assert: (self platform label isKindOf: String). + self deny: self platform label isEmpty + ] + + testNumArgs [ + + self assert: #not numArgs isZero. + self assert: #+ numArgs = 1. + self assert: #and: numArgs = 1. + self assert: #value:value: numArgs = 2 + ] + + testPrintStringLimitedTo [ + + | 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 [ + + 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." + + + | a b | + a := self platform secureHashFor: 'foobar'. + b := self platform secureHashFor: 'foobar'. + self assert: a = b + ] + + testStackDepth [ + + | 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" + + + self assert: #name asMutator = #name: + ] + + testTotalSeconds [ + "Answer the total seconds since the Squeak epoch: 1 January 1901." + + + | seconds | + seconds := Time totalSeconds. + self assert: seconds isInteger. + self assert: seconds > 3421645167 + ] + + testVersion [ + + self assert: (self platform version isKindOf: GRVersion). + self assert: (self platform versionString isKindOf: String). + self deny: self platform versionString isEmpty + ] + + testRandomGenerator [ + + | 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" + + + | stream | + stream := '' readStream. + self assert: stream atEnd. + stream := 'a' readStream. + self deny: stream atEnd + ] + + testReadStreamContents [ + "ANSI 5.9.3.1" + + + | 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." + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | stream | + stream := 'abc' readStream. + stream next: 2. + stream reset. + self assert: stream next = $a + ] + + testReadStreamSkip [ + "ANSI 5.9.2.9" + + + | stream | + stream := 'abcd' readStream. + self assert: (stream + skip: 2; + peek) = $c + ] + + testReadStreamUpTo [ + "ANSI 5.9.2.11" + + + | 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." + + + | 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" + + + | stream | + stream := GRPlatform current readWriteCharacterStream. + self assert: stream atEnd. + stream + nextPut: $a; + reset. + self deny: stream atEnd + ] + + testReadWriteStreamContents [ + "ANSI 5.9.3.1" + + + | 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." + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | 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" + + + | stream | + stream := GRPlatform current readWriteCharacterStream. + stream tab. + self assert: stream contents first = Character tab + ] + + testReadWriteStreamUpTo [ + "ANSI 5.9.2.11" + + + | 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." + + + | 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" + + + | stream | + stream := WriteStream on: String new. + stream nextPutAll: 'abc'. + self assert: stream contents = 'abc'. + stream nextPutAll: 'def'. + self assert: stream contents = 'abcdef' + ] + + testWriteStreamCrLf [ + + | 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" + + + | stream | + stream := WriteStream on: String new. + stream nextPut: $a. + self assert: stream contents = 'a' + ] + + testWriteStreamNextPutAll [ + "ANSI 5.9.4.4" + + + | 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" + + + | 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" + + + | stream | + stream := WriteStream on: String new. + stream space. + self assert: stream contents first = Character space + ] + + testWriteStreamTab [ + "ANSI 5.9.4.6" + + + | stream | + stream := WriteStream on: String new. + stream tab. + self assert: stream contents first = Character tab + ] + + testReadStreamSeasideUpToAll [ + + | 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." + + + [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." + + + [self platform addToStartUpList: self class] + ensure: [self platform removeFromStartUpList: self class] + ] + + testTerminate [ + + | 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) + ] +] + diff --git a/grease/Tests/Core/GRPrinterTest.st b/grease/Tests/Core/GRPrinterTest.st new file mode 100644 index 0000000..8512ad0 --- /dev/null +++ b/grease/Tests/Core/GRPrinterTest.st @@ -0,0 +1,805 @@ +TestCase subclass: GRPrinterTest [ + + + + + GRPrinterTest class >> packageNamesUnderTest [ + + ^#('Grease-Core') + ] + + testComposedPrinter [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | converter | + converter := GRSignPrinter new. + converter + negativePrinter: $-; + positivePrinter: $+. + self assert: (converter print: 12) = '+'. + self assert: (converter print: -12) = '-' + ] + + testStringPrinter [ + + | converter | + converter := GRStringPrinter new. + self assert: (converter print: 123) = '123'. + self assert: (converter print: 'foo') = 'foo'. + self assert: (converter print: true) = 'true' + ] + + testStringPrinterLength [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | 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 [ + + | printer | + printer := GRPrinter swissCurrency. + self assert: (printer print: 12.34) = 'CHF 12.35'. + self assert: (printer print: -12.39) = 'CHF -12.40' + ] + + testUsCurrency [ + + | printer | + printer := GRPrinter usCurrency. + self assert: (printer print: 12.34) = '$12.34'. + self assert: (printer print: -12.34) = '-$12.34' + ] +] + diff --git a/grease/Tests/Core/GRSetTest.st b/grease/Tests/Core/GRSetTest.st new file mode 100644 index 0000000..b510092 --- /dev/null +++ b/grease/Tests/Core/GRSetTest.st @@ -0,0 +1,36 @@ +GRCollectionTest subclass: GRSetTest [ + + + + + allowsDuplicateValues [ + + ^false + ] + + collectionClass [ + + ^Set + ] + + isExtensible [ + + ^true + ] + + isInitializable [ + + ^true + ] + + isSequenced [ + + ^false + ] + + isSequencedReadable [ + + ^false + ] +] + diff --git a/grease/Tests/Core/GRSmallDictionaryTest.st b/grease/Tests/Core/GRSmallDictionaryTest.st new file mode 100644 index 0000000..5a2d169 --- /dev/null +++ b/grease/Tests/Core/GRSmallDictionaryTest.st @@ -0,0 +1,321 @@ +TestCase subclass: GRSmallDictionaryTest [ + | collection | + + + + + allowsDuplicateKeys [ + + ^false + ] + + collectionClass [ + + ^GRSmallDictionary + ] + + isKey: anObject equivalentTo: anotherObject [ + + ^anObject = anotherObject + ] + + newCollection [ + + ^self collectionClass new + ] + + assertAssociations: anOrderedCollection [ + + | 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 [ + + super setUp. + collection := self newCollection + ] + + testAddAll [ + + | 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 [ + + | 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 [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + | 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 [ + + 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 [ + + | 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 [ + + | 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 [ + + collection + add: '1' -> 'foo'; + add: '2' -> 'bar'; + add: '1' -> 'baz'. + self assert: collection keys + = (self allowsDuplicateKeys ifTrue: [#('1' '2' '1')] ifFalse: [#('1' '2')]) + ] + + testKeysAndValuesDo [ + + | 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 [ + + | 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 [ + + collection + add: '1' -> 'foo'; + add: '2' -> 'bar'; + add: '1' -> 'baz'. + self + assert: collection values = (self allowsDuplicateKeys + ifTrue: [#('foo' 'bar' 'baz')] + ifFalse: [#('baz' 'bar')]) + ] + + testIncludesKey [ + + self deny: (collection includesKey: '1'). + collection add: '1' -> 'foo'. + collection add: '1' -> 'bar'. + self assert: (collection includesKey: '1') + ] + + testIsCollection [ + + self assert: collection isCollection + ] + + testIsDictionary [ + + self assert: collection isDictionary + ] + + testIsEmpty [ + + self assert: collection isEmpty. + collection add: '1' -> 'foo'. + collection add: '1' -> 'bar'. + self deny: collection isEmpty + ] +] + diff --git a/grease/Tests/Core/GRStringTest.st b/grease/Tests/Core/GRStringTest.st new file mode 100644 index 0000000..acb4ab7 --- /dev/null +++ b/grease/Tests/Core/GRStringTest.st @@ -0,0 +1,269 @@ +GRCollectionTest subclass: GRStringTest [ + + + + + allowDuplicateValues [ + + ^true + ] + + arbitraryCollection [ + + ^ 'fadbbc' copy "String literals are immutable" + ] + + collectionClass [ + + ^String + ] + + duplicateElement [ + + ^$b + ] + + excludedElement [ + + ^$Q + ] + + includedElement [ + + ^$d + ] + + isExtensible [ + + ^false + ] + + isInitializable [ + + ^true + ] + + isSequenced [ + + ^true + ] + + isSequencedReadable [ + + ^true + ] + + testAsUppercase [ + + self assert: 'abc' asUppercase = 'ABC'. + self assert: 'ABC' asUppercase = 'ABC' + ] + + testCapitalized [ + + 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 [ + + self assert: 'äöü' capitalized = 'Äöü'. + self assert: 'Äöü' capitalized = 'Äöü'. + self assert: 'ÄÖÜ' capitalized = 'ÄÖÜ'. + self assert: #'äöü' capitalized = #'Äöü'. + self assert: #'Äöü' capitalized = #'Äöü'. + self assert: #'ÄÖÜ' capitalized = #'ÄÖÜ' + ]" + + testCopyAfter [ + + self assert: ('de_CH' copyAfter: $_) = 'CH' + ] + + testCopyAfterLast [ + + self assert: ('britney.sex.tape.mkv' copyAfterLast: $.) = 'mkv'. + self assert: ('britney.sex.tape.mkv' copyAfterLast: $$) = '' + ] + + testCopyUpTo [ + + self assert: ('britney.sex.tape.mkv' copyUpTo: $.) = 'britney'. + self assert: ('britney.sex.tape.mkv' copyUpTo: $$) = 'britney.sex.tape.mkv' + ] + + testCopyUpToLast [ + + self assert: ('britney.sex.tape.mkv' copyUpToLast: $.) = 'britney.sex.tape' + ] + + testIncludesSubString [ + + self assert: ('britney.sex.tape.mkv' beginsWith: 'britney'). + self deny: ('britney.sex.tape.mkv' beginsWith: 'sex') + ] + + testSubStrings [ + + "#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 [ + + 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 [ + + self assert: ('' excerpt: '') isNil. + self assert: ('' excerpt: 'x') isNil. + self assert: ('x' excerpt: '') isNil + ] + + testExcerptLeft [ + + 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 [ + + 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 [ + + self assert: 'vertice' pluralize = 'vertices'. + self assert: 'index' pluralize = 'indices' + ] + + testInflectorCommonSuffixes [ + + self assert: 'mouse' pluralize = 'mice'. + self assert: 'synopse' pluralize = 'synopses'. + self assert: 'man' pluralize = 'men' + ] + + testInflectorFfffSuffixes [ + + self assert: 'life' pluralize = 'lives'. + self assert: 'wolf' pluralize = 'wolves' + ] + + testInflectorIrregular [ + + 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 [ + + self assert: 'fish' pluralize = 'fish'. + self assert: 'travois' pluralize = 'travois'. + self assert: 'chassis' pluralize = 'chassis'. + self assert: 'nationalities' pluralize = 'nationalities' + ] + + testInflectorTsssSuffixes [ + + self assert: 'church' pluralize = 'churches'. + self assert: 'class' pluralize = 'classes' + ] + + testInflectorYyyySuffixes [ + + self assert: 'story' pluralize = 'stories'. + self assert: 'lady' pluralize = 'ladies'. + self assert: 'stay' pluralize = 'stays'. + ] + + testTrimBoth [ + + 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 [ + + 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 [ + + 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 [ + + 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 [ + + self assert: '' truncate = '' + ] +] diff --git a/grease/Tests/Core/GRUtf8CodecTest.st b/grease/Tests/Core/GRUtf8CodecTest.st new file mode 100644 index 0000000..115cc5b --- /dev/null +++ b/grease/Tests/Core/GRUtf8CodecTest.st @@ -0,0 +1,76 @@ +TestCase subclass: GRUtf8CodecTest [ + + + + + asString: aCollectionOfIntegers [ + + ^aCollectionOfIntegers asByteArray asString + ] + + seasideByteArray [ + + ^#(83 101 97 115 105 100 101) asByteArray "Seaside" + ] + + decodedString [ + + ^'Übèrstrîñgé' + ] + + utf8String [ + + ^self asString: + #(195 156 98 195 168 114 115 116 114 195 174 195 177 103 195 169) + ] + + testCodecUtf8 [ + + #('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 [ + + #('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" + + + #('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 [ + + | stream | + stream := (GRCodec forEncoding: 'utf8') + encoderFor: self seasideByteArray readStream. + self assert: stream next = $S. + self assert: (stream next: 1) = 'e' + ] +] + diff --git a/grease/Tests/Core/GRVersionTest.st b/grease/Tests/Core/GRVersionTest.st new file mode 100644 index 0000000..a702451 --- /dev/null +++ b/grease/Tests/Core/GRVersionTest.st @@ -0,0 +1,183 @@ +TestCase subclass: GRVersionTest [ + + + + + assert: aVersionArray equals: bVersionArray [ + + | 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 [ + + | 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 [ + + ^(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 [ + + 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 [ + + | 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 [ + + 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 [ + + 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' + ] +] + diff --git a/grease/Tests/GST/Core/GRGSTPlatformTest.st b/grease/Tests/GST/Core/GRGSTPlatformTest.st new file mode 100644 index 0000000..d91073c --- /dev/null +++ b/grease/Tests/GST/Core/GRGSTPlatformTest.st @@ -0,0 +1,89 @@ +TestCase subclass: GRGSTPlatformTest [ + + + + + testCompileIntoClassified [ + + | 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 [ + + | 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 [ + + self assert: Object fullName = 'Object' + ] + + testGreaseIntegerOnCharacter [ + + | character | + character := Character codePoint: 19982. + self assert: character greaseInteger = 19982. + character := UnicodeCharacter value: 19982. + self assert: character greaseInteger = 19982. + ] + + testDirectedMessageValueWithPossibleArguments [ + + | 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 + ] +] + diff --git a/grease/package.st b/grease/package.st new file mode 100644 index 0000000..77d1189 --- /dev/null +++ b/grease/package.st @@ -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 +] diff --git a/grease/package.xml b/grease/package.xml new file mode 100644 index 0000000..ee3e7a1 --- /dev/null +++ b/grease/package.xml @@ -0,0 +1,213 @@ + + Grease + git://github.com/NicolasPetton/Grease.git + Grease + Iconv + Digest + SUnit + + Tests/Core/GRCodecTest.st + Tests/Core/GRIntervalTest.st + Tests/Core/GRNumberTest.st + Tests/Core/GRDelayedSendTest.st + Tests/Core/GRExceptionTest.st + Tests/Core/GRDictionaryTest.st + Tests/Core/GRErrorStub.st + Tests/Core/GRObjectStub.st + Tests/Core/GRBagTest.st + Tests/Core/GRNullCodecStreamTest.st + Tests/Core/GRVersionTest.st + Tests/Core/GRDurationTest.st + Tests/Core/GRSmallDictionaryTest.st + Tests/Core/GRUtf8CodecTest.st + Tests/Core/GRSetTest.st + Tests/Core/GRPlatformTest.st + Tests/Core/GRPrinterTest.st + Tests/Core/GRObjectTest.st + Tests/Core/GRNotificationStub.st + Tests/Core/GRPackageTest.st + Tests/Core/GRCollectionTest.st + Tests/Core/GRArrayTest.st + Tests/Core/GROrderedMultiMapTest.st + Tests/Core/GROrderedCollectionTest.st + Tests/Core/GRIdentityDictionaryTest.st + Tests/Core/GRStringTest.st + Tests/Core/GRAbstractDictionaryTest.st + Tests/GST/Core/GRGSTPlatformTest.st + Tests/Core/GRCodecTest.st + Tests/Core/GRIntervalTest.st + Tests/Core/GRNumberTest.st + Tests/Core/GRDelayedSendTest.st + Tests/Core/GRExceptionTest.st + Tests/Core/GRDictionaryTest.st + Tests/Core/GRErrorStub.st + Tests/Core/GRObjectStub.st + Tests/Core/GRBagTest.st + Tests/Core/GRNullCodecStreamTest.st + Tests/Core/GRVersionTest.st + Tests/Core/GRDurationTest.st + Tests/Core/GRSmallDictionaryTest.st + Tests/Core/GRUtf8CodecTest.st + Tests/Core/GRSetTest.st + Tests/Core/GRPlatformTest.st + Tests/Core/GRPrinterTest.st + Tests/Core/GRObjectTest.st + Tests/Core/GRNotificationStub.st + Tests/Core/GRPackageTest.st + Tests/Core/GRCollectionTest.st + Tests/Core/GRArrayTest.st + Tests/Core/GROrderedMultiMapTest.st + Tests/Core/GROrderedCollectionTest.st + Tests/Core/GRIdentityDictionaryTest.st + Tests/Core/GRStringTest.st + Tests/Core/GRAbstractDictionaryTest.st + Tests/GST/Core/GRGSTPlatformTest.st + + 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 + + + Core/GRObject.st + Core/GRPlatform.st + Core/GRPackage.st + Core/GRVersion.st + Core/Exceptions.st + Core/Extensions.st + Core/Collections/GRSmallDictionary.st + Core/Collections/GROrderedMultiMap.st + Core/Text/GRCodec.st + Core/Text/GRNullCodec.st + Core/Text/GRCodecStream.st + Core/Text/GRNullCodecStream.st + Core/Text/GRInflector.st + Core/Text/GRInvalidUtf8Error.st + Core/Text/GRPrinter.st + Core/Text/GRMappedPrinter.st + Core/Text/GRNumberPrinter.st + Core/Text/GROrdinalizePrinter.st + Core/Text/GRPluggablePrinter.st + Core/Text/GRSequentialPrinter.st + Core/Text/GRSignPrinter.st + Core/Text/GRStringPrinter.st + Core/Text/GRUnitPrinter.st + Core/Text/GRUnsupportedEncodingError.st + Core/Utilities/GRDelayedSend.st + Core/Utilities/GRBoundDelayedSend.st + Core/Utilities/GRUnboundDelayedSend.st + Core/Utilities/GRInvalidArgumentCount.st + GST/Core/Extensions.st + GST/Core/GRGSTGenericCodec.st + GST/Core/GRGSTPlatform.st + GST/Core/GRGSTRandomProvider.st + Tests/Core/GRCodecTest.st + Tests/Core/GRCollectionTest.st + Tests/Core/GRAbstractDictionaryTest.st + Tests/Core/GRDictionaryTest.st + Tests/Core/GRIdentityDictionaryTest.st + Tests/Core/GRArrayTest.st + Tests/Core/GRBagTest.st + Tests/Core/GRIntervalTest.st + Tests/Core/GROrderedCollectionTest.st + Tests/Core/GRSetTest.st + Tests/Core/GRStringTest.st + Tests/Core/GRDelayedSendTest.st + Tests/Core/GRDurationTest.st + Tests/Core/GRErrorStub.st + Tests/Core/GRExceptionTest.st + Tests/Core/GRNotificationStub.st + Tests/Core/GRNullCodecStreamTest.st + Tests/Core/GRNumberTest.st + Tests/Core/GRObjectStub.st + Tests/Core/GRObjectTest.st + Tests/Core/GRPackageTest.st + Tests/Core/GRPlatformTest.st + Tests/Core/GRPrinterTest.st + Tests/Core/GRSmallDictionaryTest.st + Tests/Core/GROrderedMultiMapTest.st + Tests/Core/GRUtf8CodecTest.st + Tests/Core/GRVersionTest.st + Tests/GST/Core/GRGSTPlatformTest.st + Core/GRObject.st + Core/GRPlatform.st + Core/GRPackage.st + Core/GRVersion.st + Core/Exceptions.st + Core/Extensions.st + Core/Collections/GRSmallDictionary.st + Core/Collections/GROrderedMultiMap.st + Core/Text/GRCodec.st + Core/Text/GRNullCodec.st + Core/Text/GRCodecStream.st + Core/Text/GRNullCodecStream.st + Core/Text/GRInflector.st + Core/Text/GRInvalidUtf8Error.st + Core/Text/GRPrinter.st + Core/Text/GRMappedPrinter.st + Core/Text/GRNumberPrinter.st + Core/Text/GROrdinalizePrinter.st + Core/Text/GRPluggablePrinter.st + Core/Text/GRSequentialPrinter.st + Core/Text/GRSignPrinter.st + Core/Text/GRStringPrinter.st + Core/Text/GRUnitPrinter.st + Core/Text/GRUnsupportedEncodingError.st + Core/Utilities/GRDelayedSend.st + Core/Utilities/GRBoundDelayedSend.st + Core/Utilities/GRUnboundDelayedSend.st + Core/Utilities/GRInvalidArgumentCount.st + GST/Core/Extensions.st + GST/Core/GRGSTGenericCodec.st + GST/Core/GRGSTPlatform.st + GST/Core/GRGSTRandomProvider.st + Tests/Core/GRCodecTest.st + Tests/Core/GRCollectionTest.st + Tests/Core/GRAbstractDictionaryTest.st + Tests/Core/GRDictionaryTest.st + Tests/Core/GRIdentityDictionaryTest.st + Tests/Core/GRArrayTest.st + Tests/Core/GRBagTest.st + Tests/Core/GRIntervalTest.st + Tests/Core/GROrderedCollectionTest.st + Tests/Core/GRSetTest.st + Tests/Core/GRStringTest.st + Tests/Core/GRDelayedSendTest.st + Tests/Core/GRDurationTest.st + Tests/Core/GRErrorStub.st + Tests/Core/GRExceptionTest.st + Tests/Core/GRNotificationStub.st + Tests/Core/GRNullCodecStreamTest.st + Tests/Core/GRNumberTest.st + Tests/Core/GRObjectStub.st + Tests/Core/GRObjectTest.st + Tests/Core/GRPackageTest.st + Tests/Core/GRPlatformTest.st + Tests/Core/GRPrinterTest.st + Tests/Core/GRSmallDictionaryTest.st + Tests/Core/GROrderedMultiMapTest.st + Tests/Core/GRUtf8CodecTest.st + Tests/Core/GRVersionTest.st + Tests/GST/Core/GRGSTPlatformTest.st +