Packages December 2018

packages@lists.squeakfoundation.org

1 participants
51 discussions

The Trunk: 60Deprecated-pre.28.mcz
by commits＠source.squeak.org 11 Dec '18

11 Dec '18

Patrick Rein uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-pre.28.mcz ==================== Summary ==================== Name: 60Deprecated-pre.28 Author: pre Time: 11 December 2018, 3:32:24.564299 pm UUID: 199d307d-7685-41ef-b09a-8b270897feca Ancestors: 60Deprecated-mt.27 Deprecating a method which was already deprecated before but not in a deprecated package. =============== Diff against 60Deprecated-mt.27 =============== Item was added: + ----- Method: DirectoryEntry class>>name:creationTime:modificationTime:isDirectory:fileSize: (in category '*60Deprecated-Files-Directories') ----- + name: name0 creationTime: creationTime modificationTime: modificationTime isDirectory: isDirectory fileSize: fileSize + "This is the legacy creation method we are trying to phase out. Please use #directory: name: creationTime: modificationTime: fileSize:." + | type | + type := isDirectory + ifTrue: [ DirectoryEntryDirectory ] + ifFalse: [ DirectoryEntryFile ]. + ^ type + directory: nil + name: name0 + creationTime: creationTime + modificationTime: modificationTime + fileSize: fileSize!

1 0

The Trunk: Files-pre.182.mcz
by commits＠source.squeak.org 11 Dec '18

11 Dec '18

Patrick Rein uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-pre.182.mcz ==================== Summary ==================== Name: Files-pre.182 Author: pre Time: 11 December 2018, 3:28:52.883299 pm UUID: 093bb32f-7338-44b8-a2b7-250c5d9c0956 Ancestors: Files-nice.163, Files-tpr.181 Recategorizes methods in the files package. Also moves a deprecated method into the corresponding deprecated extension category. =============== Diff against Files-tpr.181 =============== Item was changed: + ----- Method: AsyncFile>>close (in category 'file open/close') ----- - ----- Method: AsyncFile>>close (in category 'as yet unclassified') ----- close fileHandle ifNil: [^ self]. "already closed" self primClose: fileHandle. Smalltalk unregisterExternalObject: semaphore. semaphore := nil. fileHandle := nil. ! Item was changed: + ----- Method: AsyncFile>>fileHandle (in category 'accessing') ----- - ----- Method: AsyncFile>>fileHandle (in category 'as yet unclassified') ----- fileHandle ^ fileHandle! Item was changed: + ----- Method: AsyncFile>>open:forWrite: (in category 'file open/close') ----- - ----- Method: AsyncFile>>open:forWrite: (in category 'as yet unclassified') ----- open: fullFileName forWrite: aBoolean "Open a file of the given name, and return a handle for that file. Answer the receiver if the primitive succeeds, nil otherwise. If openForWrite is true, then: if there is no existing file with this name, then create one else open the existing file in read-write mode otherwise: if there is an existing file with this name, then open it read-only else answer nil." "Note: if an exisiting file is opened for writing, it is NOT truncated. If truncation is desired, the file should be deleted before being opened as an asynchronous file." "Note: On some platforms (e.g., Mac), a file can only have one writer at a time." name := fullFileName. writeable := aBoolean. ^Smalltalk newExternalSemaphoreDo: [ :newSemaphore :index | fileHandle := self primOpen: name asVmPathName forWrite: writeable semaIndex: index. fileHandle ifNotNil: [ semaphore := newSemaphore. self ] ifNil: [ Smalltalk unregisterExternalObject: newSemaphore. nil ] ]! Item was changed: + ----- Method: AsyncFile>>readByteCount:fromFilePosition:onCompletionDo: (in category 'reading') ----- - ----- Method: AsyncFile>>readByteCount:fromFilePosition:onCompletionDo: (in category 'as yet unclassified') ----- readByteCount: byteCount fromFilePosition: fPosition onCompletionDo: aBlock "Start a read operation to read byteCount's from the given position in this file. and fork a process to await its completion. When the operation completes, evaluate the given block. Note that, since the completion block may run asynchronous, the client may need to use a SharedQueue or a semaphore for synchronization." | buffer | buffer := String new: byteCount. self primReadStart: fileHandle fPosition: fPosition count: byteCount. "here's the process that awaits the results:" [| n | [ semaphore wait. n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: byteCount. n = Busy. ] whileTrue. "loop while busy in case the semaphore had excess signals" n = ErrorCode ifTrue: [^ self error: 'asynchronous read operation failed']. aBlock value: buffer. ] forkAt: Processor userInterruptPriority. ! Item was changed: + ----- Method: AsyncFile>>test:fileName: (in category 'tests') ----- - ----- Method: AsyncFile>>test:fileName: (in category 'as yet unclassified') ----- test: byteCount fileName: fileName "AsyncFile new test: 10000 fileName: 'testData'" | buf1 buf2 bytesWritten bytesRead | buf1 := String new: byteCount withAll: $x. buf2 := String new: byteCount. self open: ( FileDirectory default fullNameFor: fileName) forWrite: true. self primWriteStart: fileHandle fPosition: 0 fromBuffer: buf1 at: 1 count: byteCount. semaphore wait. bytesWritten := self primWriteResult: fileHandle. self close. self open: ( FileDirectory default fullNameFor: fileName) forWrite: false. self primReadStart: fileHandle fPosition: 0 count: byteCount. semaphore wait. bytesRead := self primReadResult: fileHandle intoBuffer: buf2 at: 1 count: byteCount. self close. buf1 = buf2 ifFalse: [self error: 'buffers do not match']. ^ 'wrote ', bytesWritten printString, ' bytes; ', 'read ', bytesRead printString, ' bytes' ! Item was changed: + ----- Method: AsyncFile>>waitForCompletion (in category 'private') ----- - ----- Method: AsyncFile>>waitForCompletion (in category 'as yet unclassified') ----- waitForCompletion semaphore wait! Item was changed: + ----- Method: AsyncFile>>writeBuffer:atFilePosition:onCompletionDo: (in category 'private') ----- - ----- Method: AsyncFile>>writeBuffer:atFilePosition:onCompletionDo: (in category 'as yet unclassified') ----- writeBuffer: buffer atFilePosition: fPosition onCompletionDo: aBlock "Start an operation to write the contents of the buffer at given position in this file, and fork a process to await its completion. When the write completes, evaluate the given block. Note that, since the completion block runs asynchronously, the client may need to use a SharedQueue or a semaphore for synchronization." self primWriteStart: fileHandle fPosition: fPosition fromBuffer: buffer at: 1 count: buffer size. "here's the process that awaits the results:" [| n | [ semaphore wait. n := self primWriteResult: fileHandle. n = Busy. ] whileTrue. "loop while busy in case the semaphore had excess signals" n = ErrorCode ifTrue: [^ self error: 'asynchronous write operation failed']. n = buffer size ifFalse: [^ self error: 'did not write the entire buffer']. aBlock value. ] forkAt: Processor userInterruptPriority. ! Item was removed: - ----- Method: DirectoryEntry class>>name:creationTime:modificationTime:isDirectory:fileSize: (in category 'deprecated') ----- - name: name0 creationTime: creationTime modificationTime: modificationTime isDirectory: isDirectory fileSize: fileSize - "This is the legacy creation method we are trying to phase out. Please use #directory: name: creationTime: modificationTime: fileSize:." - | type | - type := isDirectory - ifTrue: [ DirectoryEntryDirectory ] - ifFalse: [ DirectoryEntryFile ]. - ^ type - directory: nil - name: name0 - creationTime: creationTime - modificationTime: modificationTime - fileSize: fileSize! Item was changed: + ----- Method: FilePath class>>classVersion (in category 'accessing') ----- - ----- Method: FilePath class>>classVersion (in category 'as yet unclassified') ----- classVersion ^ 1. ! Item was changed: + ----- Method: RemoteString class>>currentTextAttVersion (in category 'accessing') ----- - ----- Method: RemoteString class>>currentTextAttVersion (in category 'as yet unclassified') ----- currentTextAttVersion "The current configuration of the TextAttributes classes has a structures array describing the inst vars of the classes (SmartRefStream instVarInfo:). Return tag that indexes the TextAttributeStructureVersions dictionary (4 random characters)." ^ CurrentTextAttVersion "Be sure to run makeNewTextAttVersion when any TextAttributes class changes inst vars"! Item was changed: + ----- Method: RemoteString class>>initialize (in category 'class initialization') ----- - ----- Method: RemoteString class>>initialize (in category 'as yet unclassified') ----- initialize "Derive the current TextAttributes classes object structure" self new makeNewTextAttVersion! Item was changed: + ----- Method: RemoteString class>>newFileNumber:position: (in category 'instance creation') ----- - ----- Method: RemoteString class>>newFileNumber:position: (in category 'as yet unclassified') ----- newFileNumber: sourceIndex position: anInteger + "Answer an instance of me for a file indexed by sourceIndex, at the - "Answer an instance of me fora file indexed by sourceIndex, at the position anInteger. Assume that the string is already stored on the file and the instance will be used to access it." ^self new fileNumber: sourceIndex position: anInteger! Item was changed: + ----- Method: RemoteString class>>newString:onFileNumber: (in category 'instance creation') ----- - ----- Method: RemoteString class>>newString:onFileNumber: (in category 'as yet unclassified') ----- newString: aString onFileNumber: sourceIndex "Answer an instance of me for string, aString, on file indexed by sourceIndex. Put the string on the file and create the remote reference." ^self new string: aString onFileNumber: sourceIndex! Item was changed: + ----- Method: RemoteString class>>newString:onFileNumber:toFile: (in category 'instance creation') ----- - ----- Method: RemoteString class>>newString:onFileNumber:toFile: (in category 'as yet unclassified') ----- newString: aString onFileNumber: sourceIndex toFile: aFileStream "Answer an instance of me for string, aString, on file indexed by sourceIndex. Put the string on the file, aFileStream, and create the remote reference. Assume that the index corresponds properly to aFileStream." ^self new string: aString onFileNumber: sourceIndex toFile: aFileStream! Item was changed: + ----- Method: RemoteString class>>structureAt: (in category 'accessing') ----- - ----- Method: RemoteString class>>structureAt: (in category 'as yet unclassified') ----- structureAt: styleVersion ^ TextAttributeStructureVersions at: styleVersion ifAbsent: [nil]!

1 0

The Trunk: Tools-pre.836.mcz
by commits＠source.squeak.org 10 Dec '18

10 Dec '18

Patrick Rein uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-pre.836.mcz ==================== Summary ==================== Name: Tools-pre.836 Author: pre Time: 10 December 2018, 8:30:57.971104 pm UUID: 8ebb3f5b-a8fa-4080-a59f-c1f6c58556e9 Ancestors: Tools-pre.835 Moves the categorize all uncategorized logic from Browser to ClassOrganizer =============== Diff against Tools-pre.835 =============== Item was changed: ----- Method: Browser>>categorizeAllUncategorizedMethods (in category 'message category list') ----- categorizeAllUncategorizedMethods "Categorize methods by looking in parent classes for a method category." + self classOrMetaClassOrganizer classifyAllUnclassified. - | organizer organizers | - organizer := self classOrMetaClassOrganizer. - organizers := self selectedClassOrMetaClass withAllSuperclasses collect: [:ea | ea organization]. - (organizer listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found | - found := (organizers collect: [ :org | org categoryOfElement: sel]) - detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]] - ifNone: []. - found ifNotNil: [organizer classify: sel under: found]]. - self changed: #messageCategoryList!

1 0

The Trunk: Kernel-pre.1201.mcz
by commits＠source.squeak.org 10 Dec '18

10 Dec '18

Patrick Rein uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-pre.1201.mcz ==================== Summary ==================== Name: Kernel-pre.1201 Author: pre Time: 10 December 2018, 8:25:07.937104 pm UUID: dab70206-4253-46e9-ae56-19ae786abf5a Ancestors: Kernel-fn.1200 Adds the classifyAllUnclassified method to ClassOrganizer. The method name remains consistent with the classify* methods of organizers. Further recategorizes some methods from accessing to classifying =============== Diff against Kernel-fn.1200 =============== Item was changed: + ----- Method: BasicClassOrganizer>>hasNoComment (in category 'testing') ----- - ----- Method: BasicClassOrganizer>>hasNoComment (in category 'accessing') ----- hasNoComment "Answer whether the class classified by the receiver has a comment." ^classComment == nil! Item was changed: + ----- Method: BasicClassOrganizer>>hasSubject (in category 'testing') ----- - ----- Method: BasicClassOrganizer>>hasSubject (in category 'accessing') ----- hasSubject ^ self subject notNil! Item was changed: + ----- Method: Categorizer>>classify:under: (in category 'classifying') ----- - ----- Method: Categorizer>>classify:under: (in category 'accessing') ----- classify: element under: heading self classify: element under: heading suppressIfDefault: true! Item was changed: + ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'classifying') ----- - ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'accessing') ----- classify: element under: heading suppressIfDefault: aBoolean "Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein" | catName catIndex elemIndex realHeading | ((heading = NullCategory) or: [heading == nil]) ifTrue: [realHeading := Default] ifFalse: [realHeading := heading asSymbol]. (catName := self categoryOfElement: element) = realHeading ifTrue: [^ self]. "done if already under that category" catName ~~ nil ifTrue: [(aBoolean and: [realHeading = Default]) ifTrue: [^ self]. "return if non-Default category already assigned in memory" self basicRemoveElement: element]. "remove if in another category" (categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading]. catIndex := categoryArray indexOf: realHeading. elemIndex := catIndex > 1 ifTrue: [categoryStops at: catIndex - 1] ifFalse: [0]. [(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex) and: [element >= (elementArray at: elemIndex)]] whileTrue. "elemIndex is now the index for inserting the element. Do the insertion before it." elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1 with: (Array with: element). "add one to stops for this and later categories" catIndex to: categoryArray size do: [:i | categoryStops at: i put: (categoryStops at: i) + 1]. ((categoryArray includes: Default) and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default]. self assertInvariant.! Item was changed: + ----- Method: Categorizer>>classifyAll:under: (in category 'classifying') ----- - ----- Method: Categorizer>>classifyAll:under: (in category 'accessing') ----- classifyAll: aCollection under: heading aCollection do: [:element | self classify: element under: heading]! Item was changed: + ----- Method: ClassOrganizer>>classify:under:logged: (in category 'classifying') ----- - ----- Method: ClassOrganizer>>classify:under:logged: (in category 'accessing') ----- classify: element under: heading logged: aBoolean self classify: element under: heading suppressIfDefault: true logged: aBoolean ! Item was changed: + ----- Method: ClassOrganizer>>classify:under:suppressIfDefault: (in category 'classifying') ----- - ----- Method: ClassOrganizer>>classify:under:suppressIfDefault: (in category 'accessing') ----- classify: element under: heading suppressIfDefault: aBoolean self classify: element under: heading suppressIfDefault: aBoolean logged: false ! Item was changed: + ----- Method: ClassOrganizer>>classify:under:suppressIfDefault:logged: (in category 'classifying') ----- - ----- Method: ClassOrganizer>>classify:under:suppressIfDefault:logged: (in category 'accessing') ----- classify: element under: heading suppressIfDefault: aBoolean logged: logged | oldCat newCat | oldCat := self categoryOfElement: element. SystemChangeNotifier uniqueInstance doSilently: [ super classify: element under: heading suppressIfDefault: aBoolean]. newCat := self categoryOfElement: element. self notifyOfChangedSelector: element from: oldCat to: newCat. logged ifTrue: [self logChangedSelector: element category: newCat]. ! Item was added: + ----- Method: ClassOrganizer>>classifyAllUnclassified (in category 'classifying') ----- + classifyAllUnclassified + + | organizers | + organizers := self subject withAllSuperclasses collect: [:ea | ea organization]. + (self listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found | + found := (organizers collect: [ :org | org categoryOfElement: sel]) + detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]] + ifNone: []. + found ifNotNil: [self classify: sel under: found]]. + !

1 0

The Trunk: Environments-pre.73.mcz
by commits＠source.squeak.org 10 Dec '18

10 Dec '18

Patrick Rein uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-pre.73.mcz ==================== Summary ==================== Name: Environments-pre.73 Author: pre Time: 10 December 2018, 8:22:12.052104 pm UUID: 6aba9a17-992b-45d5-b0a6-c646e3cdb7ff Ancestors: Environments-dtl.72 Recategorizes uncategorized messages in the Environments package. =============== Diff against Environments-dtl.72 =============== Item was changed: + ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'instance creation') ----- - ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'as yet unclassified') ----- prefix: aString ^ self basicNew initializeWithPrefix: aString! Item was changed: + ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') ----- - ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') ----- initializeWithPrefix: aString self initialize. prefix := aString! Item was changed: + ----- Method: AddPrefixNamePolicy>>name:do: (in category 'naming') ----- - ----- Method: AddPrefixNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ (aSymbol beginsWith: prefix) ifFalse: [aBlock value: (prefix, aSymbol) asSymbol]. ! Item was changed: + ----- Method: Alias class>>key:source: (in category 'instance creation') ----- - ----- Method: Alias class>>key:source: (in category 'as yet unclassified') ----- key: aSymbol source: anAssociation ^ self basicNew initializeWithKey: aSymbol source: anAssociation! Item was changed: + ----- Method: AllNamePolicy>>name:do: (in category 'naming') ----- - ----- Method: AllNamePolicy>>name:do: (in category 'as yet unclassified') ----- name: aSymbol do: aBlock ^ aBlock value: aSymbol! Item was changed: + ----- Method: Binding class>>convertInstances (in category 'system management') ----- - ----- Method: Binding class>>convertInstances (in category 'as yet unclassified') ----- convertInstances | new old | old := Binding allInstances. new := old collect: [:ea | ClassBinding key: ea key value: ea value]. old elementsForwardIdentityTo: new. old := ReadOnlyVariableBinding allInstances. new := old collect: [:ea | ClassBinding key: ea key value: ea value]. old elementsForwardIdentityTo: new. Environment allInstancesDo: [:env | #('contents' 'bindings' 'public' 'undeclared') do: [:var || dict | old := Array new writeStream. new := Array new writeStream. dict := env instVarNamed: var. dict associations do: [:binding | binding class == Association ifTrue: [old nextPut: binding. new nextPut: binding key => binding value]]. old contents elementsForwardIdentityTo: new contents]]! Item was changed: + ----- Method: Binding>>analogousCodeTo: (in category 'comparing') ----- - ----- Method: Binding>>analogousCodeTo: (in category 'as yet unclassified') ----- analogousCodeTo: anObject "For MethodProperties comparison." ^anObject isVariableBinding and: [self key = anObject key and: [self value = anObject value]]! Item was changed: + ----- Method: Binding>>canAssign (in category 'accessing') ----- - ----- Method: Binding>>canAssign (in category 'as yet unclassified') ----- canAssign ^ true! Item was changed: + ----- Method: Binding>>isSpecialReadBinding (in category 'testing') ----- - ----- Method: Binding>>isSpecialReadBinding (in category 'as yet unclassified') ----- isSpecialReadBinding ^ false! Item was changed: + ----- Method: Binding>>isSpecialWriteBinding (in category 'testing') ----- - ----- Method: Binding>>isSpecialWriteBinding (in category 'as yet unclassified') ----- isSpecialWriteBinding ^ false! Item was changed: + ----- Method: Binding>>objectForDataStream: (in category 'objects from disk') ----- - ----- Method: Binding>>objectForDataStream: (in category 'as yet unclassified') ----- objectForDataStream: refStrm "I am about to be written on an object file. I am a global, so write a proxy that will hook up with the same resource in the destination system." | dp | dp := DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt: args: (Array with: key). refStrm replace: self with: dp. ^ dp! Item was changed: + ----- Method: Binding>>printOn: (in category 'printing') ----- - ----- Method: Binding>>printOn: (in category 'as yet unclassified') ----- printOn: aStream key printOn: aStream. aStream nextPutAll: '=>'. self value printOn: aStream! Item was changed: + ----- Method: Binding>>source (in category 'accessing') ----- - ----- Method: Binding>>source (in category 'as yet unclassified') ----- source ^ self! Item was changed: + ----- Method: BindingPolicy class>>environment:policy:addSelector:removeSelector: (in category 'instance creation') ----- - ----- Method: BindingPolicy class>>environment:policy:addSelector:removeSelector: (in category 'as yet unclassified') ----- environment: anEnvironment policy: aNamePolicy addSelector: addSelector removeSelector: removeSelector ^ self basicNew initializeWithEnvironment: anEnvironment policy: aNamePolicy addSelector: addSelector removeSelector: removeSelector! Item was changed: + ----- Method: ClassBinding class>>key:value: (in category 'instance creation') ----- - ----- Method: ClassBinding class>>key:value: (in category 'as yet unclassified') ----- key: key value: value ^ self basicNew initializeWithKey: key value: value! Item was changed: + ----- Method: ClassBinding>>asBinding: (in category 'converting') ----- - ----- Method: ClassBinding>>asBinding: (in category 'as yet unclassified') ----- asBinding: aSymbol ^ aSymbol == key ifTrue: [self] ifFalse: [Alias key: aSymbol source: self]! Item was changed: + ----- Method: ClassBinding>>canAssign (in category 'accessing') ----- - ----- Method: ClassBinding>>canAssign (in category 'as yet unclassified') ----- canAssign ^ false! Item was changed: + ----- Method: ClassBinding>>initializeWithKey:value: (in category 'initialize-release') ----- - ----- Method: ClassBinding>>initializeWithKey:value: (in category 'as yet unclassified') ----- initializeWithKey: kObject value: vObject self initialize. key := kObject. value := vObject.! Item was changed: + ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'testing') ----- - ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'as yet unclassified') ----- isSpecialWriteBinding ^ true! Item was changed: + ----- Method: ClassBinding>>literalEqual: (in category 'comparing') ----- - ----- Method: ClassBinding>>literalEqual: (in category 'as yet unclassified') ----- literalEqual: other "Class bindings are equal when the bind the same class" ^ self species = other species and: [self value = other value]! Item was changed: + ----- Method: ClassBinding>>value (in category 'evaluating') ----- - ----- Method: ClassBinding>>value (in category 'as yet unclassified') ----- value ^ value! Item was changed: + ----- Method: ClassBinding>>value: (in category 'accessing') ----- - ----- Method: ClassBinding>>value: (in category 'as yet unclassified') ----- value: anObject (AttemptToWriteReadOnlyGlobal signal: 'Cannot store into read-only bindings') ifTrue: [value := anObject]! Item was changed: + ----- Method: Environment>>beCurrentDuring: (in category 'evaluating') ----- - ----- Method: Environment>>beCurrentDuring: (in category 'as yet unclassified') ----- beCurrentDuring: aBlock "Evaluate aBlock with me as the current dynamic Environment" ^ aBlock on: CurrentEnvironment do: [:e | e resume: self]! Item was changed: + ----- Method: EnvironmentLoader>>evaluate: (in category 'private') ----- - ----- Method: EnvironmentLoader>>evaluate: (in category 'as yet unclassified') ----- evaluate: chunk ^ [Compiler evaluate: chunk environment: environment] on: CurrentEnvironment do: [:req | req resume: environment]! Item was changed: + ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'private') ----- - ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'as yet unclassified') ----- evaluate: chunk logged: aBoolean ^ [Compiler evaluate: chunk environment: environment logged: aBoolean] on: CurrentEnvironment do: [:req | req resume: environment]! Item was changed: + ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'fileIn/out') ----- - ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'as yet unclassified') ----- fileIn: aStream announcing: aString | val | self logStart: aStream name. aString displayProgressFrom: 0 to: aStream size during: [:bar | [aStream atEnd] whileFalse: [bar value: aStream position. aStream skipSeparators. [val := self fileInChunkFrom: aStream] on: InMidstOfFileinNotification do: [:ex | ex resume: true]. aStream skipStyleChunk]. aStream close]. self logEnd: aStream name. ^ val! Item was changed: + ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'fileIn/out') ----- - ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'as yet unclassified') ----- fileInChunkFrom: aStream | chunk | ^ (aStream peekFor: $!!) ifTrue: [ | reader | chunk := aStream nextChunk. reader := self evaluate: chunk logged: false. reader scanFrom: aStream environment: environment] ifFalse: [ chunk := aStream nextChunk. aStream checkForPreamble: chunk. self evaluate: chunk logged: true ]! Item was changed: + ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'initialize-release') ----- - ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'as yet unclassified') ----- initializeWithEnvironment: anEnvironment self initialize. environment := anEnvironment! Item was changed: + ----- Method: EnvironmentLoader>>logEnd: (in category 'private') ----- - ----- Method: EnvironmentLoader>>logEnd: (in category 'as yet unclassified') ----- logEnd: filename "Note: The main purpose of this banner is to flush the changes file." Smalltalk logChange: '----End fileIn of ' , filename , ' into ', environment name, '----' ! Item was changed: + ----- Method: EnvironmentLoader>>logStart: (in category 'private') ----- - ----- Method: EnvironmentLoader>>logStart: (in category 'as yet unclassified') ----- logStart: filename Smalltalk logChange: '----Start fileIn of ' , filename , ' into ' , environment name , '----'! Item was changed: + ----- Method: EnvironmentsAPIDocumentation class>>asHelpTopic (in category 'converting') ----- - ----- Method: EnvironmentsAPIDocumentation class>>asHelpTopic (in category 'as yet unclassified') ----- asHelpTopic ^ (HelpTopic named: self bookName) subtopics: (self packages collect: [:pkgName | PackageAPIHelpTopic new packageName: pkgName]); yourself! Item was changed: + ----- Method: EnvironmentsAPIDocumentation class>>bookName (in category 'accessing') ----- - ----- Method: EnvironmentsAPIDocumentation class>>bookName (in category 'as yet unclassified') ----- bookName ^'Reference'! Item was changed: + ----- Method: EnvironmentsAPIDocumentation class>>packages (in category 'private') ----- - ----- Method: EnvironmentsAPIDocumentation class>>packages (in category 'as yet unclassified') ----- packages ^#('Environments-Core' 'Environments-Loading' 'Environments-Policies')! Item was changed: + ----- Method: ExplicitNamePolicy class>>aliases: (in category 'instance creation') ----- - ----- Method: ExplicitNamePolicy class>>aliases: (in category 'as yet unclassified') ----- aliases: aCollection ^ self basicNew initializeWithAliases: aCollection! Item was changed: + ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'private') ----- - ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'create') ----- flattenSpec: anObject into: names anObject isSymbol ifTrue: [^ names at: anObject put: anObject]. anObject isVariableBinding ifTrue: [^ names add: anObject]. anObject isDictionary ifTrue: [^ names addAll: anObject]. anObject do: [:ea | self flattenSpec: ea into: names]! Item was changed: + ----- Method: ExplicitNamePolicy class>>spec: (in category 'instance creation') ----- - ----- Method: ExplicitNamePolicy class>>spec: (in category 'create') ----- spec: anObject | aliases | (anObject isKindOf: NamePolicy) ifTrue: [^ anObject]. aliases := IdentityDictionary new. self flattenSpec: anObject into: aliases. ^ self aliases: aliases! Item was changed: + ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'initialize-release') ----- - ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'as yet unclassified') ----- initializeWithAliases: aCollection self initialize. aliases := IdentityDictionary withAll: aCollection! Item was changed: + ----- Method: ExplicitNamePolicy>>name:do: (in category 'naming') ----- - ----- Method: ExplicitNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ aBlock value: (aliases at: aSymbol ifAbsent: [^ nil])! Item was changed: + ----- Method: Global class>>key:value: (in category 'instance creation') ----- - ----- Method: Global class>>key:value: (in category 'as yet unclassified') ----- key: aSymbol value: anObject ^ self basicNew initializeWithKey: aSymbol value: anObject! Item was changed: + ----- Method: Global>>asBinding: (in category 'converting') ----- - ----- Method: Global>>asBinding: (in category 'as yet unclassified') ----- asBinding: aSymbol ^ aSymbol == key ifTrue: [self] ifFalse: [Alias key: aSymbol source: self]! Item was changed: + ----- Method: Global>>initializeWithKey:value: (in category 'initialize-release') ----- - ----- Method: Global>>initializeWithKey:value: (in category 'as yet unclassified') ----- initializeWithKey: aSymbol value: anObject self initialize. key := aSymbol. value := anObject! Item was changed: + ----- Method: Global>>literalEqual: (in category 'comparing') ----- - ----- Method: Global>>literalEqual: (in category 'as yet unclassified') ----- literalEqual: other "Globals are only equal to themselves, since another global with the same name could have a different value in the future." ^ self == other! Item was changed: + ----- Method: Global>>value (in category 'evaluating') ----- - ----- Method: Global>>value (in category 'as yet unclassified') ----- value ^ value! Item was changed: + ----- Method: Global>>value: (in category 'accessing') ----- - ----- Method: Global>>value: (in category 'as yet unclassified') ----- value: anObject value := anObject! Item was changed: + ----- Method: NamePolicy>>name:do: (in category 'naming') ----- - ----- Method: NamePolicy>>name:do: (in category 'as yet unclassified') ----- name: aSymbol do: aBlock self subclassResponsibility! Item was changed: + ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'instance creation') ----- - ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'as yet unclassified') ----- prefix: aString ^ self basicNew initializeWithPrefix: aString! Item was changed: + ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') ----- - ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') ----- initializeWithPrefix: aString self initialize. prefix := aString! Item was changed: + ----- Method: RemovePrefixNamePolicy>>name:do: (in category 'naming') ----- - ----- Method: RemovePrefixNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ (aSymbol beginsWith: prefix) ifTrue: [aBlock value: (aSymbol allButFirst: prefix size) asSymbol]!

1 0

The Trunk: Kernel-fn.1200.mcz
by commits＠source.squeak.org 10 Dec '18

10 Dec '18

Fabio Niephaus uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-fn.1200.mcz ==================== Summary ==================== Name: Kernel-fn.1200 Author: fn Time: 10 December 2018, 11:04:26.031004 am UUID: 4bac5539-ca56-4e57-bf97-da1450d7a168 Ancestors: Kernel-eem.1199 Fix WeakMessageSend's class comment. =============== Diff against Kernel-eem.1199 =============== Item was changed: Object weakSubclass: #WeakMessageSend instanceVariableNames: 'selector shouldBeNil arguments' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Objects'! + !WeakMessageSend commentStamp: 'fn 12/10/2018 11:03' prior: 0! + Instances of WeakMessageSend encapsulate message sends to objects, like MessageSend. Unlike MessageSend it is not necessarily a valid message. A request to value only results in a send if in fact it is valid. - !WeakMessageSend commentStamp: 'tlk 5/5/2006 12:39' prior: 0! - Instances of WeakMessageSend encapsulate message sends to objects, like MessageSend. Unlike MessageSend it is not necessarily a valid mesage. A request to value only results in a send if infact it is valid. + See MessageSendComments also. WeakMessageSend is used primarily for event registration. - See MessageSendComments also. WeakMessageSend is used primarily for event regristration. + Unlike MessageSend WeakMessageSend stores receiver (object receiving the message send) as the first and only element of its array as opposed to a named ivar. - Unlike MessageSend WeakMessageSend stoes receiver (object receiving the message send) as a the first and only element of its array as opposed to a named ivar. But like MessageSend, it does have selector Symbol -- message selector arguments Array -- bound arguments and it also has + shouldBeNil Array of Booleans -- used to track valid nil values in arguments array! - shouldBeNil Boolean -- used to ensure array of arguments is not all nils!

1 0

The Trunk: Chronology-Tests-dtl.12.mcz
by commits＠source.squeak.org 09 Dec '18

09 Dec '18

David T. Lewis uploaded a new version of Chronology-Tests to project The Trunk: http://source.squeak.org/trunk/Chronology-Tests-dtl.12.mcz ==================== Summary ==================== Name: Chronology-Tests-dtl.12 Author: dtl Time: 8 December 2018, 8:28:30.117609 pm UUID: dad57e40-eeda-4f10-b9f6-740115fb92bb Ancestors: Chronology-Tests-cmm.11 Add DateAndTimeReferenceStreamTest to verify reference stream serialization for DateAndTime and Date. Tests are written in a traditional Chronology image, and will pass for both Spur and V3 Squeak images. When DateAndTime class is updated for UTCDateAndTime, saved instances must be compatible with the original serialization format because serialiized instances are used extensively in Monticello, and compatibility with saved sources is required. Therefore it is necessary that these tests pass after installation of UTCDateAndTime. =============== Diff against Chronology-Tests-cmm.11 =============== Item was added: + TestCase subclass: #DateAndTimeReferenceStreamTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Chronology-Tests'! + + !DateAndTimeReferenceStreamTest commentStamp: 'dtl 12/8/2018 15:03' prior: 0! + Verify reference stream serialization for DateAndTime and Date. Tests are written in a Cronology-Classic image and should pass in a Chronology-UTC image.! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testArrayOfDateAndTimeToBytes (in category 'testing') ----- + testArrayOfDateAndTimeToBytes + + | a bytes expectedBytes | + a := Array + with: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + with: '2018-12-08T14:16:16.931528-05:00' asDateAndTime + with: #endMarker. + expectedBytes := #[8 0 0 0 3 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 5 0 10 4 0 0 200 176 16 3 0 33 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 55 133 253 64 6 9 101 110 100 77 97 114 107 101 114]. + bytes := (ReferenceStream on: ByteArray new writeStream) + nextPut: a; + yourself; + contents. + self assert: expectedBytes equals: bytes + description: 'serialized bytes should match expected bytes'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testArrayWithDateToBytes (in category 'testing') ----- + testArrayWithDateToBytes + + | date a bytes expectedBytes | + date := Date + starting: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + duration: 1 day + 13 seconds. + a := Array + with: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + with: date + with: '2018-12-08T14:16:16.931528-05:00' asDateAndTime + with: #endMarker. + expectedBytes := #[8 0 0 0 4 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 9 0 0 0 3 6 4 68 97 116 101 16 5 0 10 4 0 0 134 206 16 3 0 33 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 3 0 33 4 0 0 0 0 4 0 1 81 141 16 5 0 10 4 0 0 200 176 16 3 0 33 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 55 133 253 64 6 9 101 110 100 77 97 114 107 101 114]. + bytes := (ReferenceStream on: ByteArray new writeStream) + nextPut: a; + yourself; + contents. + self assert: expectedBytes equals: bytes + description: 'serialized bytes should match expected bytes'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testBytesToArrayOfDateAndTime (in category 'testing') ----- + testBytesToArrayOfDateAndTime + + | bytes expected materializedArray | + expected := Array + with: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + with: '2018-12-08T14:16:16.931528-05:00' asDateAndTime + with: #endMarker. + . + bytes := #[8 0 0 0 3 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 5 0 10 4 0 0 200 176 10 0 0 0 28 4 0 37 131 93 4 55 133 253 64 6 9 101 110 100 77 97 114 107 101 114]. + materializedArray := (ReferenceStream on: bytes readStream) next. + self assert: expected equals: materializedArray + description: 'materialized from bytes should match expected array objects'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testBytesToArrayWithfDate (in category 'testing') ----- + testBytesToArrayWithfDate + + | date bytes expected materializedArray | + date := Date + starting: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + duration: 1 day + 13 seconds. + expected := Array + with: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + with: date + with: '2018-12-08T14:16:16.931528-05:00' asDateAndTime + with: #endMarker. + bytes := #[8 0 0 0 4 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 9 0 0 0 3 6 4 68 97 116 101 16 5 0 10 4 0 0 134 206 16 3 0 33 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 3 0 33 4 0 0 0 0 4 0 1 81 141 16 5 0 10 4 0 0 200 176 16 3 0 33 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 55 133 253 64 6 9 101 110 100 77 97 114 107 101 114]. + materializedArray := (ReferenceStream on: bytes readStream) next. + self assert: expected equals: materializedArray + description: 'materialized from bytes should match expected array objects'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testBytesToDate (in category 'testing') ----- + testBytesToDate + + | bytes expected materializedDate | + expected := Date + starting: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + duration: 1 day + 13 seconds. + bytes := #[9 0 0 0 3 6 4 68 97 116 101 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 3 0 39 4 0 0 0 0 4 0 1 81 141]. + materializedDate := (ReferenceStream on: bytes readStream) next. + self assert: expected equals: materializedDate + description: 'materialized from bytes should match expected DateAndTime'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testBytesToDateAndTime (in category 'testing') ----- + testBytesToDateAndTime + + | bytes expected materializedDateAndTime | + expected := '2018-12-08T09:35:10.913743-05:00' asDateAndTime. + bytes := #[9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152]. + materializedDateAndTime := (ReferenceStream on: bytes readStream) next. + self assert: expected equals: materializedDateAndTime + description: 'materialized from bytes should match expected DateAndTime'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testDateAndTimeToBytes (in category 'testing') ----- + testDateAndTimeToBytes + + | dt bytes expectedBytes | + dt := '2018-12-08T09:35:10.913743-05:00' asDateAndTime. + expectedBytes := #[9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152]. + bytes := (ReferenceStream on: ByteArray new writeStream) + nextPut: dt; + yourself; + contents. + self assert: expectedBytes equals: bytes + description: 'serialized bytes should match expected bytes'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testDateToBytes (in category 'testing') ----- + testDateToBytes + + | date bytes expectedBytes | + date := Date + starting: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + duration: 1 day + 13 seconds. + expectedBytes := #[9 0 0 0 3 6 4 68 97 116 101 9 0 0 0 5 6 11 68 97 116 101 65 110 100 84 105 109 101 4 0 0 134 206 9 0 0 0 3 6 8 68 117 114 97 116 105 111 110 4 0 0 0 0 4 255 255 185 176 4 0 37 131 93 4 54 118 156 152 16 3 0 39 4 0 0 0 0 4 0 1 81 141]. + bytes := (ReferenceStream on: ByteArray new writeStream) + nextPut: date; + yourself; + contents. + self assert: expectedBytes equals: bytes + description: 'serialized bytes should match expected bytes'. + + + ! Item was added: + ----- Method: DateAndTimeReferenceStreamTest>>testSeriailizeAndDeserializeArrayOfDateAndTime (in category 'testing') ----- + testSeriailizeAndDeserializeArrayOfDateAndTime + + | date a bytes newArray | + date := Date + starting: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + duration: 1 day + 13 seconds. + a := Array + with: '2018-12-08T09:35:10.913743-05:00' asDateAndTime + with: date + with: '2018-12-08T14:16:16.931528-05:00' asDateAndTime + with: #endMarker. + bytes := (ReferenceStream on: ByteArray new writeStream) + nextPut: a; + yourself; + contents. + newArray := (ReferenceStream on: bytes readStream) next. + self assert: a equals: newArray. + + + !

1 0

The Trunk: Sound-pre.65.mcz
by commits＠source.squeak.org 07 Dec '18

07 Dec '18

Patrick Rein uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-pre.65.mcz ==================== Summary ==================== Name: Sound-pre.65 Author: pre Time: 7 December 2018, 4:27:31.425037 pm UUID: ed53607e-fbea-4ed9-bc9e-9bad91b11372 Ancestors: Sound-pre.64 Categorizes uncategorized messages in the Sound package (1250 methods to go). =============== Diff against Sound-pre.64 =============== Item was changed: + ----- Method: AmbientEvent>>morph (in category 'accessing') ----- - ----- Method: AmbientEvent>>morph (in category 'as yet unclassified') ----- morph ^ morph! Item was changed: + ----- Method: AmbientEvent>>morph: (in category 'accessing') ----- - ----- Method: AmbientEvent>>morph: (in category 'as yet unclassified') ----- morph: m morph := m! Item was changed: + ----- Method: AmbientEvent>>occurAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'sound generation') ----- - ----- Method: AmbientEvent>>occurAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'as yet unclassified') ----- occurAtTime: ticks inScorePlayer: player atIndex: index inEventTrack: track secsPerTick: secsPerTick (target == nil or: [selector == nil]) ifTrue: [morph ifNil: [^ self]. ^ morph encounteredAtTime: ticks inScorePlayer: player atIndex: index inEventTrack: track secsPerTick: secsPerTick]. target perform: selector withArguments: arguments! Item was changed: + ----- Method: AmbientEvent>>target:selector:arguments: (in category 'accessing') ----- - ----- Method: AmbientEvent>>target:selector:arguments: (in category 'as yet unclassified') ----- target: t selector: s arguments: a target := t. selector := s. arguments := a. ! Item was changed: + ----- Method: CompressedSoundData>>compressWith: (in category 'compressing') ----- - ----- Method: CompressedSoundData>>compressWith: (in category 'as yet unclassified') ----- compressWith: codecClass codecName == codecClass name asSymbol ifTrue: [^self]. ^self asSound compressWith: codecClass! Item was changed: + ----- Method: CompressedSoundData>>compressWith:atRate: (in category 'compressing') ----- - ----- Method: CompressedSoundData>>compressWith:atRate: (in category 'as yet unclassified') ----- compressWith: codecClass atRate: aSamplingRate (codecName == codecClass name asSymbol and: [samplingRate = aSamplingRate]) ifTrue: [^self]. ^self asSound compressWith: codecClass atRate: aSamplingRate! Item was changed: + ----- Method: CompressedSoundData>>withEToySound:samplingRate: (in category 'initialize-release') ----- - ----- Method: CompressedSoundData>>withEToySound:samplingRate: (in category 'as yet unclassified') ----- withEToySound: aByteArray samplingRate: anInteger soundClassName := #SampledSound. channels := {aByteArray}. codecName := #GSMCodec. loopEnd := nil. "???" loopLength := nil. perceivedPitch := 100.0. samplingRate := anInteger. gain := 1.0. "???" firstSample := 1. cachedSound := nil. "???"! Item was changed: + ----- Method: FMBassoonSound>>setPitch:dur:loudness: (in category 'initialization') ----- - ----- Method: FMBassoonSound>>setPitch:dur:loudness: (in category 'as yet unclassified') ----- setPitch: pitchNameOrNumber dur: d loudness: l "Select a modulation ratio and modulation envelope scale based on my pitch." | p modScale | p := self nameOrNumberToPitch: pitchNameOrNumber. modScale := 9.4. p > 100.0 ifTrue: [modScale := 8.3]. p > 150.0 ifTrue: [modScale := 6.4]. p > 200.0 ifTrue: [modScale := 5.2]. p > 300.0 ifTrue: [modScale := 3.9]. p > 400.0 ifTrue: [modScale := 2.8]. p > 600.0 ifTrue: [modScale := 1.7]. envelopes size > 0 ifTrue: [ envelopes do: [:e | (e updateSelector = #modulation:) ifTrue: [e scale: modScale]]]. super setPitch: p dur: d loudness: l. ! Item was changed: + ----- Method: MIDIFileReader class>>scoreFromFileNamed: (in category 'reading') ----- - ----- Method: MIDIFileReader class>>scoreFromFileNamed: (in category 'as yet unclassified') ----- scoreFromFileNamed: fileName | f score | f := (FileStream readOnlyFileNamed: fileName) binary. score := (self new readMIDIFrom: f) asScore. f close. ^ score ! Item was changed: + ----- Method: MIDIFileReader class>>scoreFromStream: (in category 'reading') ----- - ----- Method: MIDIFileReader class>>scoreFromStream: (in category 'as yet unclassified') ----- scoreFromStream: binaryStream | score | score := (self new readMIDIFrom: binaryStream) asScore. ^ score ! Item was changed: + ----- Method: MIDIFileReader class>>scoreFromURL: (in category 'reading') ----- - ----- Method: MIDIFileReader class>>scoreFromURL: (in category 'as yet unclassified') ----- scoreFromURL: urlString | data | data := HTTPSocket httpGet: urlString accept: 'audio/midi'. data binary. ^ (self new readMIDIFrom: data) asScore. ! Item was changed: + ----- Method: MIDIFileReader class>>standardMIDIInstrumentNames (in category 'instruments') ----- - ----- Method: MIDIFileReader class>>standardMIDIInstrumentNames (in category 'as yet unclassified') ----- standardMIDIInstrumentNames "Answer an array of Standard MIDI instrument names." ^ #( 'Grand Piano' 'Bright Piano' 'Electric Grand Piano' 'Honky-tonk Piano' 'Electric Piano 1' 'Electric Piano 2' 'Harpsichord' 'Clavichord' 'Celesta' 'Glockenspiel' 'Music Box' 'Vibraphone' 'Marimba' 'Xylophone' 'Tubular Bells' 'Duclimer' 'Drawbar Organ' 'Percussive Organ' 'Rock Organ' 'Church Organ' 'Reed Organ' 'Accordion' 'Harmonica' 'Tango Accordion' 'Nylon Guitar' 'Steel Guitar' 'Electric Guitar 1' 'Electric Guitar 2' 'Electric Guitar 3' 'Overdrive Guitar' 'Distorted Guitar' 'Guitar Harmonics' 'Acoustic Bass' 'Electric Bass 1' 'Electric Bass 2' 'Fretless Bass' 'Slap Bass 1' 'Slap Bass 2' 'Synth Bass 1' 'Synth Bass 2' 'Violin' 'Viola' 'Cello' 'Contrabass' 'Tremolo Strings' 'Pizzicato Strings' 'Orchestral Harp' 'Timpani' 'String Ensemble 1' 'String Ensemble 2' 'Synth Strings 1' 'Synth Strings 2' 'Choir Ahhs' 'Choir Oohs' 'Synth Voice' 'Orchestra Hit' 'Trumpet' 'Trombone' 'Tuba' 'Muted Trumpet' 'French Horn' 'Brass Section' 'Synth Brass 1' 'Synth Brass 2' 'Soprano Sax' 'Alto Sax' 'Tenor Sax' 'Baritone Sax' 'Oboe' 'English Horn' 'Bassoon' 'Clarinet' 'Piccolo' 'Flute' 'Recorder' 'Pan Flute' 'Blown Bottle' 'Shakuhachi' 'Whistle' 'Ocarina' 'Lead 1 (square)' 'Lead 2 (sawtooth)' 'Lead 3 (calliope)' 'Lead 4 (chiff)' 'Lead 5 (charang)' 'Lead 6 (voice)' 'Lead 7 (fifths)' 'Lead 8 (bass+lead)' 'Pad 1 (new age)' 'Pad 2 (warm)' 'Pad 3 (polysynth)' 'Pad 4 (choir)' 'Pad 5 (bowed)' 'Pad 6 (metallic)' 'Pad 7 (halo)' 'Pad 8 (sweep)' 'FX 1 (rain)' 'FX 2 (soundtrack)' 'FX 3 (crystals)' 'FX 4 (atmosphere)' 'FX 5 (brightness)' 'FX 6 (goblins)' 'FX 7 (echoes)' 'FX 8 (sci-fi)' 'Sitar' 'Banjo' 'Shamisen' 'Koto' 'Kalimba' 'Bagpipe' 'Fiddle' 'Shanai' 'Tinkle Bell' 'Agogo' 'Steel Drum' 'Woodblock' 'Taiko Drum' 'Melodic Tom' 'Synth Drum' 'Reverse Cymbal' 'Guitar Fret Noise' 'Breath Noise' 'Seashore' 'Bird Tweet' 'Telephone Ring' 'Helicopter' 'Applause' 'Gunshot') ! Item was changed: + ----- Method: MIDISound>>play (in category 'playing') ----- - ----- Method: MIDISound>>play (in category 'as yet unclassified') ----- play "The base class ScorePlayer has two interfaces: a sound and a sound player. Choose the right interface depending on whether MIDI support is present." SoundService soundEnabled ifFalse: [^ self]. SimpleMIDIPort useMIDIDeviceForOutput ifTrue: [ [self openMIDIPort] on: Error do: [ SimpleMIDIPort askForDefault. [self openMIDIPort] on: Error do: [ self inform: 'Use of MIDI device is not working. Using custom synthesis.\Go to preferences to change again.' withCRs. SimpleMIDIPort useMIDIDeviceForOutput: false]]]. self reset; resumePlaying.! Item was changed: + ----- Method: MIDISynth>>channel: (in category 'channels') ----- - ----- Method: MIDISynth>>channel: (in category 'as yet unclassified') ----- channel: i ^ channels at: i ! Item was changed: + ----- Method: MIDISynth>>closeMIDIPort (in category 'midi port') ----- - ----- Method: MIDISynth>>closeMIDIPort (in category 'as yet unclassified') ----- closeMIDIPort midiParser midiPort ifNil: [^ self]. midiParser midiPort close. midiParser midiPort: nil. ! Item was changed: + ----- Method: MIDISynth>>initialize (in category 'initialize-release') ----- - ----- Method: MIDISynth>>initialize (in category 'as yet unclassified') ----- initialize super initialize. midiParser := MIDIInputParser on: nil. channels := (1 to: 16) collect: [:ch | MIDISynthChannel new initialize]. ! Item was changed: + ----- Method: MIDISynth>>instrumentForChannel: (in category 'channels') ----- - ----- Method: MIDISynth>>instrumentForChannel: (in category 'as yet unclassified') ----- instrumentForChannel: channelIndex ^ (channels at: channelIndex) instrument ! Item was changed: + ----- Method: MIDISynth>>instrumentForChannel:put: (in category 'channels') ----- - ----- Method: MIDISynth>>instrumentForChannel:put: (in category 'as yet unclassified') ----- instrumentForChannel: channelIndex put: aSoundProto (channels at: channelIndex) instrument: aSoundProto. ! Item was changed: + ----- Method: MIDISynth>>isOn (in category 'testing') ----- - ----- Method: MIDISynth>>isOn (in category 'as yet unclassified') ----- isOn ^ process notNil ! Item was changed: + ----- Method: MIDISynth>>midiParser (in category 'accessing') ----- - ----- Method: MIDISynth>>midiParser (in category 'as yet unclassified') ----- midiParser ^ midiParser ! Item was changed: + ----- Method: MIDISynth>>midiPort (in category 'midi port') ----- - ----- Method: MIDISynth>>midiPort (in category 'as yet unclassified') ----- midiPort ^ midiParser midiPort ! Item was changed: + ----- Method: MIDISynth>>midiPort: (in category 'midi port') ----- - ----- Method: MIDISynth>>midiPort: (in category 'as yet unclassified') ----- midiPort: aMIDIPortOrNil midiParser midiPort: aMIDIPortOrNil. ! Item was changed: + ----- Method: MIDISynth>>midiTrackingLoop (in category 'tracking') ----- - ----- Method: MIDISynth>>midiTrackingLoop (in category 'as yet unclassified') ----- midiTrackingLoop midiParser clearBuffers. [self processMIDI ifFalse: [(Delay forMilliseconds: 5) wait]] repeat! Item was changed: + ----- Method: MIDISynth>>mutedForChannel:put: (in category 'channels') ----- - ----- Method: MIDISynth>>mutedForChannel:put: (in category 'as yet unclassified') ----- mutedForChannel: channelIndex put: aBoolean ^ (channels at: channelIndex) muted: aBoolean ! Item was changed: + ----- Method: MIDISynth>>panForChannel: (in category 'channels') ----- - ----- Method: MIDISynth>>panForChannel: (in category 'as yet unclassified') ----- panForChannel: channelIndex ^ (channels at: channelIndex) pan ! Item was changed: + ----- Method: MIDISynth>>panForChannel:put: (in category 'channels') ----- - ----- Method: MIDISynth>>panForChannel:put: (in category 'as yet unclassified') ----- panForChannel: channelIndex put: newPan (channels at: channelIndex) pan: newPan. ! Item was changed: + ----- Method: MIDISynth>>processMIDI (in category 'private-tracking') ----- - ----- Method: MIDISynth>>processMIDI (in category 'as yet unclassified') ----- processMIDI "Process some MIDI commands. Answer true if any commands were processed." | didSomething | didSomething := false. midiParser midiDo: [:item | | cmdByte byte1 chan cmd byte2 | didSomething := true. cmdByte := item at: 2. byte1 := byte2 := nil. item size > 2 ifTrue: [ byte1 := item at: 3. item size > 3 ifTrue: [byte2 := item at: 4]]. cmdByte < 240 ifTrue: [ "channel message" cmd := cmdByte bitAnd: 2r11110000. chan := (cmdByte bitAnd: 2r00001111) + 1. (channels at: chan) doChannelCmd: cmd byte1: byte1 byte2: byte2] ifFalse: [ "system message" "process system messages here" ]]. ^ didSomething ! Item was changed: + ----- Method: MIDISynth>>processMIDIUntilMouseDown (in category 'private-tracking') ----- - ----- Method: MIDISynth>>processMIDIUntilMouseDown (in category 'as yet unclassified') ----- processMIDIUntilMouseDown "Used for debugging. Do MIDI processing until the mouse is pressed." midiParser clearBuffers. [Sensor anyButtonPressed] whileFalse: [self processMIDI]. ! Item was changed: + ----- Method: MIDISynth>>setAllChannelMasterVolumes: (in category 'channels') ----- - ----- Method: MIDISynth>>setAllChannelMasterVolumes: (in category 'as yet unclassified') ----- setAllChannelMasterVolumes: aNumber | vol | vol := (aNumber asFloat min: 1.0) max: 0.0. channels do: [:ch | ch masterVolume: vol]. ! Item was changed: + ----- Method: MIDISynth>>startMIDITracking (in category 'tracking') ----- - ----- Method: MIDISynth>>startMIDITracking (in category 'as yet unclassified') ----- startMIDITracking midiParser ifNil: [^ self]. midiParser midiPort ifNil: [^ self]. midiParser midiPort ensureOpen. self stopMIDITracking. SoundPlayer useShortBuffer. process := [self midiTrackingLoop] newProcess. process priority: Processor userInterruptPriority. process resume. ! Item was changed: + ----- Method: MIDISynth>>stopMIDITracking (in category 'tracking') ----- - ----- Method: MIDISynth>>stopMIDITracking (in category 'as yet unclassified') ----- stopMIDITracking process ifNotNil: [ process terminate. process := nil]. SoundPlayer shutDown: true; initialize. "revert to normal buffer size" ! Item was changed: + ----- Method: MIDISynth>>volumeForChannel: (in category 'channels') ----- - ----- Method: MIDISynth>>volumeForChannel: (in category 'as yet unclassified') ----- volumeForChannel: channelIndex ^ (channels at: channelIndex) masterVolume ! Item was changed: + ----- Method: MIDISynth>>volumeForChannel:put: (in category 'channels') ----- - ----- Method: MIDISynth>>volumeForChannel:put: (in category 'as yet unclassified') ----- volumeForChannel: channelIndex put: newVolume (channels at: channelIndex) masterVolume: newVolume. ! Item was changed: + ----- Method: PitchEnvelope>>centerPitch (in category 'accessing') ----- - ----- Method: PitchEnvelope>>centerPitch (in category 'as yet unclassified') ----- centerPitch ^ centerPitch ! Item was changed: + ----- Method: PitchEnvelope>>centerPitch: (in category 'accessing') ----- - ----- Method: PitchEnvelope>>centerPitch: (in category 'as yet unclassified') ----- centerPitch: aNumber centerPitch := aNumber. ! Item was changed: + ----- Method: PitchEnvelope>>updateSelector (in category 'accessing') ----- - ----- Method: PitchEnvelope>>updateSelector (in category 'as yet unclassified') ----- updateSelector "Needed by the envelope editor." ^ #pitch: ! Item was changed: + ----- Method: PitchEnvelope>>updateTargetAt: (in category 'applying') ----- - ----- Method: PitchEnvelope>>updateTargetAt: (in category 'as yet unclassified') ----- updateTargetAt: mSecs "Update the pitch for my target. Answer true if the value changed." "Details: Assume envelope range is 0.0..2.0, with 1 being the center pitch. Subtracting one yields the range -1.0..1.0. Raising two to this power yields pitches between half and double the center pitch; i.e. from an octave below to an octave about the center pitch." | newValue | newValue := self valueAtMSecs: mSecs. newValue ~= lastValue ifTrue: [ target pitch: (2.0 raisedTo: newValue - (scale / 2.0)) * centerPitch. lastValue := newValue. ^ true]. ^ false ! Item was changed: ----- Method: SampledSound class>>useCoffeeCupClink (in category 'default sound') ----- useCoffeeCupClink "Set the sample table to be used as the default waveform to the sound of a coffee cup being tapped with a spoon." "SampledSound useCoffeeCupClink bachFugue play" DefaultSampleTable := self coffeeCupClink. NominalSamplePitch := 400. ! Item was changed: + ----- Method: SoundBuffer>>writeOnGZIPByteStream: (in category 'objects from disk') ----- - ----- Method: SoundBuffer>>writeOnGZIPByteStream: (in category 'as yet unclassified') ----- writeOnGZIPByteStream: aStream aStream nextPutAllWordArray: self! Item was changed: + ----- Method: SoundPlayer>>startUp (in category 'system startup') ----- - ----- Method: SoundPlayer>>startUp (in category 'as yet unclassified') ----- startUp Preferences automaticPlatformSettings ifFalse: [^ self]. SoundPlayer soundQuickStart: SoundPlayer defaultQuickStartForPlatform. SoundPlayer stopSoundWhenDone: SoundPlayer defaultStopSoundForPlatform.! Item was changed: + ----- Method: TempoEvent>>isTempoEvent (in category 'classification') ----- - ----- Method: TempoEvent>>isTempoEvent (in category 'as yet unclassified') ----- isTempoEvent ^ true ! Item was changed: + ----- Method: TempoEvent>>printOn: (in category 'printing') ----- - ----- Method: TempoEvent>>printOn: (in category 'as yet unclassified') ----- printOn: aStream aStream nextPut: $(. time printOn: aStream. aStream nextPutAll: ': tempo '. aStream nextPutAll: (120.0 * (500000.0 / tempo) printShowingMaxDecimalPlaces: 2). aStream nextPut: $). ! Item was changed: + ----- Method: TempoEvent>>tempo (in category 'accessing') ----- - ----- Method: TempoEvent>>tempo (in category 'as yet unclassified') ----- tempo ^ tempo ! Item was changed: + ----- Method: TempoEvent>>tempo: (in category 'accessing') ----- - ----- Method: TempoEvent>>tempo: (in category 'as yet unclassified') ----- tempo: anInteger tempo := anInteger. ! Item was changed: + ----- Method: UnloadedSound class>>default (in category 'instruments') ----- - ----- Method: UnloadedSound class>>default (in category 'as yet unclassified') ----- default "UnloadedSound default play" | snd p | snd := super new modulation: 1 ratio: 1. p := OrderedCollection new. p add: 0(a)0.0; add: 10(a)1.0; add: 100(a)1.0; add: 120(a)0.0. snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 ! Item was changed: + ----- Method: VolumeEnvelope>>computeSlopeAtMSecs: (in category 'private') ----- - ----- Method: VolumeEnvelope>>computeSlopeAtMSecs: (in category 'as yet unclassified') ----- computeSlopeAtMSecs: mSecs "Private!! Find the next inflection point of this envelope and compute its target volume and the number of milliseconds until the inflection point is reached." | t i | ((loopEndMSecs ~~ nil) and: [mSecs >= loopEndMSecs]) ifTrue: [ "decay phase" t := (points at: loopEndIndex) x + (mSecs - loopEndMSecs). i := self indexOfPointAfterMSecs: t startingAt: loopEndIndex. i == nil ifTrue: [ "past end" targetVol := points last y * decayScale. mSecsForChange := 0. nextRecomputeTime := mSecs + 1000000. ^ self]. targetVol := (points at: i) y * decayScale. mSecsForChange := (((points at: i) x - t) min: (endMSecs - mSecs)) max: 4. nextRecomputeTime := mSecs + mSecsForChange. ^ self]. mSecs < loopStartMSecs ifTrue: [ "attack phase" i := self indexOfPointAfterMSecs: mSecs startingAt: 1. targetVol := (points at: i) y. mSecsForChange := ((points at: i) x - mSecs) max: 4. nextRecomputeTime := mSecs + mSecsForChange. ((loopEndMSecs ~~ nil) and: [nextRecomputeTime > loopEndMSecs]) ifTrue: [nextRecomputeTime := loopEndMSecs]. ^ self]. "sustain and loop phase" noChangesDuringLoop ifTrue: [ targetVol := (points at: loopEndIndex) y. mSecsForChange := 10. loopEndMSecs == nil ifTrue: [nextRecomputeTime := mSecs + 10] "unknown end time" ifFalse: [nextRecomputeTime := loopEndMSecs]. ^ self]. loopMSecs = 0 ifTrue: [^ (points at: loopEndIndex) y]. "looping on a single point" t := loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs). i := self indexOfPointAfterMSecs: t startingAt: loopStartIndex. targetVol := (points at: i) y. mSecsForChange := ((points at: i) x - t) max: 4. nextRecomputeTime := (mSecs + mSecsForChange) min: loopEndMSecs. ! Item was changed: + ----- Method: VolumeEnvelope>>reset (in category 'applying') ----- - ----- Method: VolumeEnvelope>>reset (in category 'as yet unclassified') ----- reset "Reset the state for this envelope." super reset. target initialVolume: points first y * scale. nextRecomputeTime := 0. ! Item was changed: + ----- Method: VolumeEnvelope>>updateSelector (in category 'accessing') ----- - ----- Method: VolumeEnvelope>>updateSelector (in category 'as yet unclassified') ----- updateSelector "Needed by the envelope editor." ^ #volume: ! Item was changed: + ----- Method: VolumeEnvelope>>updateTargetAt: (in category 'applying') ----- - ----- Method: VolumeEnvelope>>updateTargetAt: (in category 'as yet unclassified') ----- updateTargetAt: mSecs "Update the volume envelope slope and limit for my target. Answer false." mSecs < nextRecomputeTime ifTrue: [^ false]. self computeSlopeAtMSecs: mSecs. mSecsForChange < 5 ifTrue: [mSecsForChange := 5]. "don't change instantly to avoid clicks" target adjustVolumeTo: targetVol * scale overMSecs: mSecsForChange. ^ false ! Item was changed: + ----- Method: VolumeEnvelope>>volume: (in category 'accessing') ----- - ----- Method: VolumeEnvelope>>volume: (in category 'as yet unclassified') ----- volume: aNumber "Set the maximum volume of a volume-controlling envelope." scale := aNumber asFloat. !

1 0

The Trunk: Tests-pre.404.mcz
by commits＠source.squeak.org 07 Dec '18

07 Dec '18

Patrick Rein uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.404.mcz ==================== Summary ==================== Name: Tests-pre.404 Author: pre Time: 7 December 2018, 1:27:40.307037 pm UUID: d2787b99-db2d-4f7a-b4ed-4735c24b6eca Ancestors: Tests-dtl.403 Categorizes unclassified methods in the Tests package, also recategorizes some test methods from testing to tests but not all (another door of the message categories advent calendar) =============== Diff against Tests-dtl.403 =============== Item was changed: + ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'cleaning') ----- - ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'as yet unclassified') ----- flushCache! Item was changed: + ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'accessing') ----- - ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'as yet unclassified') ----- methodClass: aMethodClass! Item was changed: + ----- Method: AbstractObjectsAsMethod>>selector: (in category 'accessing') ----- - ----- Method: AbstractObjectsAsMethod>>selector: (in category 'as yet unclassified') ----- selector: aSymbol! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'as yet unclassified') ----- testDrawingWayOutside | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'as yet unclassified') ----- testDrawingWayOutside2 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'as yet unclassified') ----- testDrawingWayOutside3 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'as yet unclassified') ----- testDrawingWayOutside4 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'as yet unclassified') ----- testDrawingWayOutside5 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'as yet unclassified') ----- testDrawingWayOutside6 | f1 bb f2 | f1 := Form extent: 100@100 depth: 1. f2 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb sourceForm: f2. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. bb sourceOrigin: SmallInteger maxVal squared asPoint. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'as yet unclassified') ----- testFillingWayOutside | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: 100; height: 100. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'as yet unclassified') ----- testFillingWayOutside2 | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: 0@0. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits.! Item was changed: + ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'tests') ----- - ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'as yet unclassified') ----- testFillingWayOutside3 | f1 bb | f1 := Form extent: 100@100 depth: 1. bb := BitBlt toForm: f1. bb combinationRule: 3. bb fillColor: Color black. bb destOrigin: SmallInteger maxVal squared asPoint. bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared. "This should not throw an exception:" bb copyBits. ! Item was changed: + ----- Method: BitmapStreamTests class>>testSelectors (in category 'accessing') ----- - ----- Method: BitmapStreamTests class>>testSelectors (in category 'Accessing') ----- testSelectors "The ImageSegment-based Bitmap Test is known to not work on SPUR VMs with the prospect of crashing. #expectedFailure does not cut it here, don't even try to run them" ^ super testSelectors copyWithout: #testMatrixTransform2x3WithImageSegment! Item was changed: + ----- Method: BitmapStreamTests>>setUp (in category 'running') ----- - ----- Method: BitmapStreamTests>>setUp (in category 'Running') ----- setUp random := Random new.! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'testing') ----- testAddInstanceVariable "Adding an instance variable to the class should result in a change record being added to the current change set." | saveClassDefinition | "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition. self assert: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Redefine the class, adding one instance variable" Object subclass: #JunkClass instanceVariableNames: 'zzz aaa' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Assert that the class definition has changed" self deny: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: saveClassDefinition). self deny: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). self assert: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Assert that the change has been recorded in the current change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: saveClassDefinition). ! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'testing') ----- testAddInstanceVariableAddsNewChangeRecord "Changing the class category for a class should result in a change record being updated in the current change set." "At the start of this test, JunkClass should not exist, and there should be no change records pertaining to it in the change set." self deny: (Smalltalk hasClassNamed: 'JunkClass'). self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) thisName = 'nil'. "Remove bogus change records created as side effect of preceding assert" ChangeSet current removeClassChanges: 'nil'. "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Forget about JunkClass in the change set" ChangeSet current removeClassChanges: 'JunkClass'. "Redefine the class, adding one instance variable" Object subclass: #JunkClass instanceVariableNames: 'zzz aaa' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "A change record should now exist in the change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-1''') ! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'testing') ----- testChangeClassCategory "Changing the class category for a class should result in a change record being added to the current change set." | saveClassDefinition | "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition. self assert: saveClassDefinition = (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass)). "Redefine the class, changing only the class category" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-2'. "Assert that the class definition has changed" self deny: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: saveClassDefinition). self deny: (self isDefinition: saveClassDefinition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). self assert: (self isDefinition: (Smalltalk classNamed: #JunkClass) definition equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))). "Assert that the change has been recorded in the current change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-2''')! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'testing') ----- testChangeClassCategoryAddsNewChangeRecord "Changing the class category for a class should result in a change record being updated in the current change set." "At the start of this test, JunkClass should not exist, and there should be no change records pertaining to it in the change set." self deny: (Smalltalk hasClassNamed: 'JunkClass'). self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) thisName = 'nil'. "Remove bogus change records created as side effect of preceding assert" ChangeSet current removeClassChanges: 'nil'. "Define a class and save its definition" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-1'. "Forget about JunkClass in the change set" ChangeSet current removeClassChanges: 'JunkClass'. "Redefine the class, changing only the class category" Object subclass: #JunkClass instanceVariableNames: 'zzz' classVariableNames: '' poolDictionaries: '' category: 'DeleteMe-2'. "A change record should now exist in the change set" self assert: (self isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition equivalentTo: 'Object subclass: #JunkClass instanceVariableNames: ''zzz '' classVariableNames: '''' poolDictionaries: '''' category: ''DeleteMe-2''')! Item was changed: + ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'tests') ----- - ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'testing') ----- testInitialChangeSet "Run this to assure the initial changeset is named. Checks bug found in 3.9 7052." "self new testInitialChangeSet" "self run: #testInitialChangeSet" self deny: (ChangeSet current printString = 'a ChangeSet named <no name -- garbage?>') . ^true! Item was changed: + ----- Method: ClassBindingTest>>setUp (in category 'running') ----- - ----- Method: ClassBindingTest>>setUp (in category 'as yet unclassified') ----- setUp key := Object new. value := Object new.! Item was changed: + ----- Method: ClassBindingTest>>testArrowBinding (in category 'tests') ----- - ----- Method: ClassBindingTest>>testArrowBinding (in category 'as yet unclassified') ----- testArrowBinding | binding | binding := #Griffle => self class. self assert: binding class = ClassBinding. self assert: binding key = #Griffle. self assert: binding value = self class. ! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'as yet unclassified') ----- testAsBindingAlias | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self assert: imported class == Alias! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'as yet unclassified') ----- testAsBindingOriginal | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Griffle. self assert: binding == imported! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingRead (in category 'as yet unclassified') ----- testAsBindingRead | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self assert: imported key = #Plonk. self assert: imported value == value.! Item was changed: + ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'as yet unclassified') ----- testAsBindingWrite | binding imported | binding := ClassBinding key: #Griffle value: value. imported := binding asBinding: #Plonk. self should: [imported value: Object new] raise: AttemptToWriteReadOnlyGlobal ! Item was changed: + ----- Method: ClassBindingTest>>testCanAssign (in category 'tests') ----- - ----- Method: ClassBindingTest>>testCanAssign (in category 'as yet unclassified') ----- testCanAssign | binding | binding := ClassBinding key: key value: value. self deny: binding canAssign! Item was changed: + ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'as yet unclassified') ----- testIsSpecialRead | binding | binding := ClassBinding key: key value: value. self deny: binding isSpecialReadBinding! Item was changed: + ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'as yet unclassified') ----- testIsSpecialWrite | binding | binding := ClassBinding key: key value: value. self assert: binding isSpecialWriteBinding! Item was changed: + ----- Method: ClassBindingTest>>testLiteralEqual (in category 'tests') ----- - ----- Method: ClassBindingTest>>testLiteralEqual (in category 'as yet unclassified') ----- testLiteralEqual | b1 b2 | b1 := #Griffle => self class. b2 := #Plonk => self class. self assert: (b1 literalEqual: b2)! Item was changed: + ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'tests') ----- - ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'as yet unclassified') ----- testLiteralUnequal | b1 b2 | b1 := #Griffle => self class. b2 := #Griffle => self class superclass. self deny: (b1 literalEqual: b2)! Item was changed: + ----- Method: ClassBindingTest>>testRead (in category 'tests') ----- - ----- Method: ClassBindingTest>>testRead (in category 'as yet unclassified') ----- testRead | binding | binding := ClassBinding key: key value: value. self assert: binding key == key. self assert: binding value == value! Item was changed: + ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'tests') ----- - ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'as yet unclassified') ----- testResumeExceptionToWrite | binding | binding := ClassBinding key: key value: Object new. [binding value: value] on: AttemptToWriteReadOnlyGlobal do: [:ex | ex resume: true]. self assert: binding value == value! Item was changed: + ----- Method: ClassBindingTest>>testSource (in category 'tests') ----- - ----- Method: ClassBindingTest>>testSource (in category 'as yet unclassified') ----- testSource | binding | binding := ClassBinding key: #Griffle value: value. self assert: binding source == binding! Item was changed: + ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'tests') ----- - ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'as yet unclassified') ----- testWriteRaisesException | binding | binding := ClassBinding key: key value: value. self should: [binding value: Object new] raise: AttemptToWriteReadOnlyGlobal.! Item was changed: + ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'private') ----- - ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'Private') ----- newUniqueClassName "Return a class name that is not used in the system." "self new newClassName" | baseName newName | baseName := 'AutoGeneratedClassForTestingSystemChanges'. 1 to: 9999 do: [:number | newName := baseName , number printString. (Smalltalk hasClassNamed: newName) ifFalse: [^newName asSymbol]]. ^self error: 'Can no longer find a new and unique class name for the SystemChangeTest !!'! Item was changed: + ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'private') ----- - ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'Private') ----- removeEverythingInSetFromSystem: aChangeSet aChangeSet changedMessageList do: [:methodRef | methodRef actualClass removeSelector: methodRef methodSymbol]. aChangeSet changedClasses do: [:each | each isMeta ifFalse: [each removeFromSystemUnlogged]]! Item was changed: + ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'tests') ----- - ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'Tests') ----- renameClassUsing: aBlock | createdClass foundClasses | originalName := self newUniqueClassName. createdClass := Object subclass: originalName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClassRenameFix-GeneradClass'. newClassName := self newUniqueClassName. aBlock value: createdClass value: newClassName. self assert: (Smalltalk classNamed: originalName) isNil. self assert: (Smalltalk classNamed: newClassName) notNil. foundClasses := Smalltalk organization listAtCategoryNamed: 'ClassRenameFix-GeneradClass'. self assert: (foundClasses notEmpty). self assert: (foundClasses includes: newClassName). self assert: (createdClass name = newClassName).! Item was changed: + ----- Method: ClassRenameFixTest>>setUp (in category 'running') ----- - ----- Method: ClassRenameFixTest>>setUp (in category 'Running') ----- setUp previousChangeSet := ChangeSet current. testsChangeSet := ChangeSet new. ChangeSet newChanges: testsChangeSet. SystemChangeNotifier uniqueInstance notify: self ofSystemChangesOfItem: #class change: #Renamed using: #verifyRenameEvent:. super setUp! Item was changed: + ----- Method: ClassRenameFixTest>>tearDown (in category 'running') ----- - ----- Method: ClassRenameFixTest>>tearDown (in category 'Running') ----- tearDown self removeEverythingInSetFromSystem: testsChangeSet. ChangeSet newChanges: previousChangeSet. ChangesOrganizer removeChangeSet: testsChangeSet. previousChangeSet := nil. testsChangeSet := nil. SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. super tearDown.! Item was changed: + ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'tests') ----- - ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'Tests') ----- testRenameClassUsingClass "self run: #testRenameClassUsingClass" self renameClassUsing: [:class :newName | class rename: newName].! Item was changed: + ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'private') ----- - ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'Running') ----- verifyRenameEvent: aRenamedEvent | renamedClass | self assert: aRenamedEvent isRenamed. renamedClass := aRenamedEvent item. self assert: (Smalltalk classNamed: newClassName) name = newClassName. self assert: renamedClass name = newClassName! Item was changed: + ----- Method: ClipboardTest>>setUp (in category 'running') ----- - ----- Method: ClipboardTest>>setUp (in category 'as yet unclassified') ----- setUp "Store the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard." originalClipboardText := Clipboard default clipboardText! Item was changed: + ----- Method: ClipboardTest>>tearDown (in category 'running') ----- - ----- Method: ClipboardTest>>tearDown (in category 'as yet unclassified') ----- tearDown "Restore the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard." Clipboard default clipboardText: originalClipboardText! Item was changed: + ----- Method: ClipboardTest>>testClipboardText (in category 'tests') ----- - ----- Method: ClipboardTest>>testClipboardText (in category 'as yet unclassified') ----- testClipboardText | uuidString clipboard | uuidString := UUID new asString36. clipboard := Clipboard new. clipboard clipboardText: uuidString. self assert: uuidString equals: clipboard clipboardText asString! Item was changed: + ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'tests') ----- - ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'as yet unclassified') ----- testClipboardTextNotifyWith | uuidString clipboard subscriber notifiedText notifiedSource | uuidString := UUID new asString36. clipboard := Clipboard new. subscriber := [ :text :source | notifiedText := text. notifiedSource := source ]. clipboard when: #contentChanged send: #value:value: to: subscriber. clipboard clipboardText: uuidString. self assert: uuidString equals: notifiedText; assert: nil equals: notifiedSource. clipboard clipboardText: uuidString reversed notifyWith: self. self assert: uuidString reversed equals: notifiedText; assert: self == notifiedSource. clipboard removeActionsWithReceiver: subscriber. clipboard clipboardText: uuidString. self assert: uuidString reversed equals: notifiedText; assert: self == notifiedSource! Item was changed: + ----- Method: EqualityTester>>resultFor: (in category 'running') ----- - ----- Method: EqualityTester>>resultFor: (in category 'as yet unclassified') ----- resultFor: runs "Test that equality is the same over runs and answer the result" 1 to: runs do: [:i | self prototype = self prototype ifFalse: [^ false]]. ^ true! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'running-dependent action') ----- testBlockReceiverNoArgs eventSource when: #anEvent evaluate:[self heardEvent]. eventSource triggerEvent: #anEvent. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'running-dependent action') ----- testBlockReceiverOneArg eventSource when: #anEvent: evaluate:[:arg1| eventListener add: arg1]. eventSource triggerEvent: #anEvent: with: 9. self should: [eventListener includes: 9]! Item was changed: + ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'running-dependent action') ----- testBlockReceiverTwoArgs eventSource when: #anEvent:info: evaluate:[:arg1 :arg2| self addArg1: arg1 addArg2: arg2]. eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ). self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! Item was changed: + ----- Method: EventManagerTest>>testCopy (in category 'tests-copying') ----- - ----- Method: EventManagerTest>>testCopy (in category 'running-copying') ----- testCopy "Ensure that the actionMap is zapped when you make a copy of anEventManager" eventSource when: #blah send: #yourself to: eventListener. self assert: eventSource actionMap keys isEmpty not. self assert: eventSource copy actionMap keys isEmpty! Item was changed: + ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'running-broadcast query') ----- testMultipleValueSuppliers eventSource when: #needsValue send: #getFalse to: self. eventSource when: #needsValue send: #getTrue to: self. succeeded := eventSource triggerEvent: #needsValue. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'running-broadcast query') ----- testMultipleValueSuppliersEventHasArguments eventSource when: #needsValue: send: #getFalse: to: self. eventSource when: #needsValue: send: #getTrue: to: self. succeeded := eventSource triggerEvent: #needsValue: with: 'kolme'. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'running-dependent action') ----- testNoArgumentEvent eventSource when: #anEvent send: #heardEvent to: self. eventSource triggerEvent: #anEvent. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'tests-dependent action supplied arguments') ----- - ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'running-dependent action supplied arguments') ----- testNoArgumentEventDependentSuppliedArgument eventSource when: #anEvent send: #add: to: eventListener with: 'boundValue'. eventSource triggerEvent: #anEvent. self should: [eventListener includes: 'boundValue']! Item was changed: + ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'tests-dependent action supplied arguments') ----- - ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'running-dependent action supplied arguments') ----- testNoArgumentEventDependentSuppliedArguments eventSource when: #anEvent send: #addArg1:addArg2: to: self withArguments: #('hello' 'world'). eventSource triggerEvent: #anEvent. self should: [(eventListener includes: 'hello') and: [eventListener includes: 'world']]! Item was changed: + ----- Method: EventManagerTest>>testNoValueSupplier (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testNoValueSupplier (in category 'running-broadcast query') ----- testNoValueSupplier succeeded := eventSource triggerEvent: #needsValue ifNotHandled: [true]. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'running-broadcast query') ----- testNoValueSupplierHasArguments succeeded := eventSource triggerEvent: #needsValue: with: 'nelja' ifNotHandled: [true]. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'running-dependent action') ----- testOneArgumentEvent eventSource when: #anEvent: send: #add: to: eventListener. eventSource triggerEvent: #anEvent: with: 9. self should: [eventListener includes: 9]! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'running-remove actions') ----- testRemoveActionsForEvent eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsForEvent: #anEvent. self shouldnt: [eventSource hasActionForEvent: #anEvent]! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'running-remove actions') ----- testRemoveActionsTwiceForEvent eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsForEvent: #anEvent. self assert: (eventSource hasActionForEvent: #anEvent) not. eventSource removeActionsForEvent: #anEvent. self assert: (eventSource hasActionForEvent: #anEvent) not.! Item was changed: + ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'tests-remove actions') ----- - ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'running-remove actions') ----- testRemoveActionsWithReceiver | action | eventSource when: #anEvent send: #size to: eventListener; when: #anEvent send: #getTrue to: self; when: #anEvent: send: #fizzbin to: self. eventSource removeActionsWithReceiver: self. action := eventSource actionForEvent: #anEvent. self assert: (action respondsTo: #receiver). self assert: ((action receiver == self) not)! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'running-dependent value') ----- testReturnValueWithManyListeners | value newListener | newListener := 'busybody'. eventSource when: #needsValue send: #yourself to: eventListener. eventSource when: #needsValue send: #yourself to: newListener. value := eventSource triggerEvent: #needsValue. self should: [value == newListener]! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'running-dependent value') ----- testReturnValueWithNoListeners | value | value := eventSource triggerEvent: #needsValue. self should: [value == nil]! Item was changed: + ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'tests-dependent value') ----- - ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'running-dependent value') ----- testReturnValueWithOneListener | value | eventSource when: #needsValue send: #yourself to: eventListener. value := eventSource triggerEvent: #needsValue. self should: [value == eventListener]! Item was changed: + ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'tests-broadcast query') ----- - ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'running-broadcast query') ----- testSingleValueSupplier eventSource when: #needsValue send: #getTrue to: self. succeeded := eventSource triggerEvent: #needsValue. self should: [succeeded]! Item was changed: + ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'tests-dependent action') ----- - ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'running-dependent action') ----- testTwoArgumentEvent eventSource when: #anEvent:info: send: #addArg1:addArg2: to: self. eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ). self should: [(eventListener includes: 9) and: [eventListener includes: 42]]! Item was changed: + ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage ^ aMessage sendTo: self class ! Item was changed: + ----- Method: FakeObjectOut>>isInMemory (in category 'testing') ----- - ----- Method: FakeObjectOut>>isInMemory (in category 'as yet unclassified') ----- isInMemory ^ false.! Item was changed: + ----- Method: HandBugs>>testTargetPoint (in category 'tests') ----- - ----- Method: HandBugs>>testTargetPoint (in category 'as yet unclassified') ----- testTargetPoint "self new testTargetPoint" "self run: #testTargetPoint" "This should not throw an exception." ActiveHand targetPoint ! Item was changed: + ----- Method: HashAndEqualsTestCase>>setUp (in category 'running') ----- - ----- Method: HashAndEqualsTestCase>>setUp (in category 'as yet unclassified') ----- setUp "subclasses will add their prototypes into this collection" prototypes := OrderedCollection new ! Item was changed: + ----- Method: HashAndEqualsTestCase>>testEquality (in category 'tests') ----- - ----- Method: HashAndEqualsTestCase>>testEquality (in category 'as yet unclassified') ----- testEquality "Check that TextFontChanges report equality correctly" prototypes do: [:p | self should: [(EqualityTester with: p) result]] ! Item was changed: + ----- Method: HashAndEqualsTestCase>>testHash (in category 'tests') ----- - ----- Method: HashAndEqualsTestCase>>testHash (in category 'as yet unclassified') ----- testHash "test that TextFontChanges hash correctly" prototypes do: [:p | self should: [(HashTester with: p) result]] ! Item was changed: + ----- Method: HashTester>>resultFor: (in category 'running') ----- - ----- Method: HashTester>>resultFor: (in category 'as yet unclassified') ----- resultFor: runs "Test that the hash is the same over runs and answer the result" | hash | hash := self prototype hash. 1 to: runs do: [:i | hash = self prototype hash ifFalse: [^ false]]. ^ true ! Item was changed: + ----- Method: HashTesterTest>>testBasicBehaviour (in category 'tests') ----- - ----- Method: HashTesterTest>>testBasicBehaviour (in category 'as yet unclassified') ----- testBasicBehaviour self should: [(HashTester with: 1) resultFor: 100]. self should: [(HashTester with: 'fred') resultFor: 100]. self shouldnt: [(HashTester with: BadHasher new) resultFor: 100] ! Item was changed: + ----- Method: HexTest>>testCharacterHex (in category 'tests') ----- - ----- Method: HexTest>>testCharacterHex (in category 'as yet unclassified') ----- testCharacterHex | result | result := $a hex. self assert: result = '61'. result := $A hex. self assert: result = '41'. ! Item was changed: + ----- Method: HexTest>>testColorPrintHtmlString (in category 'tests') ----- - ----- Method: HexTest>>testColorPrintHtmlString (in category 'as yet unclassified') ----- testColorPrintHtmlString self assert: (Color red printHtmlString ) = ( Color red asHTMLColor allButFirst asUppercase). ! Item was changed: + ----- Method: HexTest>>testIntegerHex (in category 'tests') ----- - ----- Method: HexTest>>testIntegerHex (in category 'as yet unclassified') ----- testIntegerHex | result | result := 15 asInteger hex. self assert: result = '16rF'. result := 0 asInteger hex. self assert: result = '16r0'. result := 255 asInteger hex. self assert: result = '16rFF'. result := 90 asInteger hex. self assert: result = '16r5A'! Item was changed: + ----- Method: HexTest>>testStringAsHex (in category 'tests') ----- - ----- Method: HexTest>>testStringAsHex (in category 'as yet unclassified') ----- testStringAsHex | result | result := 'abc' asHex. self assert: result = '616263'. ! Item was changed: + ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'tests') ----- - ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'testing') ----- testContextsShouldBeWritableToaFile "This should not throw an exception" NativeImageSegment new copyFromRoots: {thisContext. thisContext copyStack} sizeHint: 100; extract; writeToFile: 'ContextChain'; yourself "TODO: write assertions showing that something meaningful actually happened." "TODO: bring them back in again"! Item was changed: + ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'tests') ----- - ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'testing') ----- testImageSegmentsShouldBeWritableToaFile "This should not throw an exception" | classes | classes := UIManager subclasses reject: [:sc| sc isActiveManager]. NativeImageSegment new copyFromRoots: classes asArray sizeHint: 100; extract; writeToFile: 'InactiveUIManagers'; yourself. "TODO: write assertions showing that something meaningful actually happened." "now bring them back in again" classes do: [:ea| ea new]! Item was changed: + ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'tests') ----- - ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'as yet unclassified') ----- testAddPackageShouldResultInCorrectUrl | url | url := (Installer url: 'http://seaside.gemstone.com/ss/metacello') addPackage: 'ConfigurationOfMetacello-dkh.754.mcz'; urlToDownload. "Note the insertion of a / in the URL." self assert: 'http://seaside.gemstone.com/ss/metacello/ConfigurationOfMetacello-dkh.754.m…' equals: url.! Item was changed: + ----- Method: LangEnvBugs>>defaultTimeout (in category 'accessing') ----- - ----- Method: LangEnvBugs>>defaultTimeout (in category 'as yet unclassified') ----- defaultTimeout ^ super defaultTimeout * 10 "seconds"! Item was changed: + ----- Method: LangEnvBugs>>tearDown (in category 'running') ----- - ----- Method: LangEnvBugs>>tearDown (in category 'as yet unclassified') ----- tearDown [Preferences restoreDefaultFonts] valueSupplyingAnswers: #(('Sorry, could not revert font choices' #default))! Item was changed: + ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'tests') ----- - ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'as yet unclassified') ----- testIsFontAvailable "self new testIsFontAvailable" "self run: #testIsFontAvailable" | oldPref | oldPref := Preferences valueOfPreference: #tinyDisplay. Preferences restoreFontsAfter: [ [Preferences enable: #tinyDisplay. "This should not throw an exception." (LanguageEnvironment localeID: (LocaleID isoLanguage: 'en')) isFontAvailable] ensure: [Preferences setPreference: #tinyDisplay toValue: oldPref]].! Item was changed: + ----- Method: LocaleTest>>setUp (in category 'running') ----- - ----- Method: LocaleTest>>setUp (in category 'testing') ----- setUp previousID := Locale current localeID. previousKeyboardInterpreter := ActiveHand instVarNamed: 'keyboardInterpreter'. previousClipboardInterpreter := Clipboard default instVarNamed: 'interpreter'. ActiveHand clearKeyboardInterpreter. Clipboard default clearInterpreter. ! Item was changed: + ----- Method: LocaleTest>>tearDown (in category 'running') ----- - ----- Method: LocaleTest>>tearDown (in category 'testing') ----- tearDown ActiveHand instVarNamed: 'keyboardInterpreter' put: previousKeyboardInterpreter. Clipboard default instVarNamed: 'interpreter' put: previousClipboardInterpreter. Locale switchToID: (LocaleID isoLanguage: previousID).! Item was changed: + ----- Method: LocaleTest>>testEncodingName (in category 'tests') ----- - ----- Method: LocaleTest>>testEncodingName (in category 'testing') ----- testEncodingName "self debug: #testEncodingName" | locale | locale := Locale isoLanguage: 'ja'. self assert: locale languageEnvironment fontEncodingName = #FontJapaneseEnvironment! Item was changed: + ----- Method: LocaleTest>>testIsFontAvailable (in category 'tests') ----- - ----- Method: LocaleTest>>testIsFontAvailable (in category 'testing') ----- testIsFontAvailable "self debug: #testIsFontAvailable" <timeout: 60> "takes quite a while" self ensureInternetConnectionTo: 'http://metatoys.org/pub/'. Preferences restoreFontsAfter: [ | currentDefaultTextStyle | currentDefaultTextStyle := TextStyle default. [ TextStyle setDefault: (TextStyle actualTextStyles at: #Accuny). (Locale isoLanguage: 'ja') languageEnvironment removeFonts. self assert: (Locale isoLanguage: 'en') languageEnvironment isFontAvailable. "Next test should fail after installing Japanese font" self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable not. (Locale isoLanguage: 'ja') languageEnvironment installFont. self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable ] ensure: [ TextStyle setDefault: currentDefaultTextStyle. FileDirectory default deleteFileNamed: (Locale isoLanguage: 'ja') languageEnvironment fontFullName. ] ].! Item was changed: + ----- Method: LocaleTest>>testLocaleChanged (in category 'tests') ----- - ----- Method: LocaleTest>>testLocaleChanged (in category 'testing') ----- testLocaleChanged "self debug: #testLocaleChanged" "LanguageEnvironment >> startUp is called from Prject >> localeChanged" <timeout: 60> "takes quite a while" Project current updateLocaleDependents. self assert: (ActiveHand instVarNamed: 'keyboardInterpreter') isNil description: 'non-nil keyboardInterpreter'. self assert: (Clipboard default instVarNamed: 'interpreter') isNil description: 'non-nil interpreter'. Locale switchToID: (LocaleID isoLanguage: 'ja'). self assert: 'ja' equals: Locale current localeID isoLanguage. Locale switchToID: (LocaleID isoLanguage: 'en'). self assert: 'en' equals: Locale current localeID isoLanguage.! Item was changed: + ----- Method: MCDirtyPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCDirtyPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ Array new: 0.! Item was changed: + ----- Method: MCDirtyPackageInfo>>methods (in category 'listing') ----- - ----- Method: MCDirtyPackageInfo>>methods (in category 'as yet unclassified') ----- methods ^ MCMockClassA selectors select: [:ea | ea beginsWith: 'ordinal'] thenCollect: [:ea | MethodReference class: MCMockClassA selector: ea].! Item was changed: + ----- Method: MCDirtyPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCDirtyPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MCDirtyPackage'! Item was changed: + ----- Method: MCEmptyPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCEmptyPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ #()! Item was changed: + ----- Method: MCEmptyPackageInfo>>methods (in category 'listing') ----- - ----- Method: MCEmptyPackageInfo>>methods (in category 'as yet unclassified') ----- methods ^ #()! Item was changed: + ----- Method: MCEmptyPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCEmptyPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MCEmptyPackage'! Item was changed: + ----- Method: MCMockClassA>>d (in category 'numeric') ----- - ----- Method: MCMockClassA>>d (in category 'as yet classified') ----- d ^ 'd'! Item was changed: + ----- Method: MCMockDefinition>>= (in category 'comparing') ----- - ----- Method: MCMockDefinition>>= (in category 'as yet unclassified') ----- = definition ^definition token = token! Item was changed: + ----- Method: MCMockDefinition>>asString (in category 'converting') ----- - ----- Method: MCMockDefinition>>asString (in category 'as yet unclassified') ----- asString ^ token! Item was changed: + ----- Method: MCMockDefinition>>description (in category 'comparing') ----- - ----- Method: MCMockDefinition>>description (in category 'as yet unclassified') ----- description ^ token first! Item was changed: + ----- Method: MCMockDefinition>>hash (in category 'comparing') ----- - ----- Method: MCMockDefinition>>hash (in category 'as yet unclassified') ----- hash ^ token hash! Item was changed: + ----- Method: MCMockDefinition>>printString (in category 'printing') ----- - ----- Method: MCMockDefinition>>printString (in category 'as yet unclassified') ----- printString ^ token! Item was changed: + ----- Method: MCMockDefinition>>summary (in category 'printing') ----- - ----- Method: MCMockDefinition>>summary (in category 'as yet unclassified') ----- summary ^ token! Item was changed: + ----- Method: MCMockDefinition>>token (in category 'accessing') ----- - ----- Method: MCMockDefinition>>token (in category 'as yet unclassified') ----- token ^ token! Item was changed: + ----- Method: MCMockDefinition>>token: (in category 'accessing') ----- - ----- Method: MCMockDefinition>>token: (in category 'as yet unclassified') ----- token: aString token := aString! Item was changed: + ----- Method: MCMockPackageInfo>>classNames (in category 'constants') ----- - ----- Method: MCMockPackageInfo>>classNames (in category 'as yet unclassified') ----- classNames ^ #( MCMockClassA MCMockASubclass MCMockClassB MCMockClassD MCMockClassE MCMockClassF MCMockClassG MCMockClassH MCMockClassI )! Item was changed: + ----- Method: MCMockPackageInfo>>classes (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>classes (in category 'as yet unclassified') ----- classes ^ self classNames select: [:name | Smalltalk hasClassNamed: name] thenCollect: [:name | Smalltalk at: name]! Item was changed: + ----- Method: MCMockPackageInfo>>extensionMethods (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>extensionMethods (in category 'as yet unclassified') ----- extensionMethods ^ Array with: (MethodReference class: MCSnapshotTest selector: #mockClassExtension)! Item was changed: + ----- Method: MCMockPackageInfo>>includesClass: (in category 'testing') ----- - ----- Method: MCMockPackageInfo>>includesClass: (in category 'as yet unclassified') ----- includesClass: aClass ^self classes includes: aClass! Item was changed: + ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'testing') ----- - ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'as yet unclassified') ----- includesSystemCategory: categoryName ^self systemCategories anySatisfy: [:cat | cat sameAs: categoryName]! Item was changed: + ----- Method: MCMockPackageInfo>>packageName (in category 'naming') ----- - ----- Method: MCMockPackageInfo>>packageName (in category 'as yet unclassified') ----- packageName ^ 'MonticelloMocks'! Item was changed: + ----- Method: MCMockPackageInfo>>systemCategories (in category 'listing') ----- - ----- Method: MCMockPackageInfo>>systemCategories (in category 'as yet unclassified') ----- systemCategories ^ Array with: 'Tests-MonticelloMocks'! Item was changed: + ----- Method: MCTestCase>>performTest (in category 'private') ----- - ----- Method: MCTestCase>>performTest (in category 'as yet unclassified') ----- performTest Utilities useAuthorInitials: self className during: [ super performTest ]! Item was changed: + ----- Method: MethodReferenceTest>>testEquals (in category 'tests') ----- - ----- Method: MethodReferenceTest>>testEquals (in category 'Running') ----- testEquals | aMethodReference anotherMethodReference | aMethodReference := MethodReference new. anotherMethodReference := MethodReference new. "Two fresh instances should be equals between them" self assert: MethodReference new equals: MethodReference new. self assert: MethodReference new hash equals: MethodReference new hash. "Two instances representing the same method (same class and same selector) should be equals" self assert: (MethodReference class: String selector: #foo) equals: (MethodReference class: String selector: #foo). self assert: (MethodReference class: String selector: #foo) hash equals: (MethodReference class: String selector: #foo) hash.! Item was changed: + ----- Method: MethodReferenceTest>>testNotEquals (in category 'tests') ----- - ----- Method: MethodReferenceTest>>testNotEquals (in category 'Running') ----- testNotEquals self deny: (MethodReference class: String selector: #foo) = (MethodReference class: String class selector: #foo) description: 'Different classes, same selector -> no more equals'. self deny: (MethodReference class: String selector: #foo) = (MethodReference class: String selector: #bar) description: 'Same class, different selectors -> no more equals'.! Item was changed: + ----- Method: NamePolicyTest class>>isAbstract (in category 'testing') ----- - ----- Method: NamePolicyTest class>>isAbstract (in category 'as yet unclassified') ----- isAbstract ^ self name = #NamePolicyTest! Item was changed: + ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'as yet unclassified') ----- add: a with: b ^a + b! Item was changed: + ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'as yet unclassified') ----- answer42 ^42! Item was changed: + ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'example methods') ----- - ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'as yet unclassified') ----- run: oldSelector with: arguments in: aReceiver ^self perform: oldSelector withArguments: arguments! Item was changed: + ----- Method: PCCByCompilationTest class>>isAbstract (in category 'testing') ----- - ----- Method: PCCByCompilationTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ false! Item was changed: + ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'testing') ----- - ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ false! Item was changed: + ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'testing') ----- - ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'Testing') ----- isAbstract ^ true! Item was changed: + ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'running') ----- - ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'tests') ----- setUp super setUp. pcc := self classToBeTested new. "set failed call" (self class >> self failedCallSelector) literals first at: 4 put: -1. "set it to false for some very slow tests..." doNotMakeSlowTestsFlag := true! Item was changed: + ----- Method: PrototypeTester>>prototype (in category 'accessing') ----- - ----- Method: PrototypeTester>>prototype (in category 'as yet unclassified') ----- prototype "Get a prototype" ^ prototype copy ! Item was changed: + ----- Method: PrototypeTester>>prototype: (in category 'accessing') ----- - ----- Method: PrototypeTester>>prototype: (in category 'as yet unclassified') ----- prototype: aPrototype "Set my prototype" prototype := aPrototype copy ! Item was changed: + ----- Method: PrototypeTester>>result (in category 'running') ----- - ----- Method: PrototypeTester>>result (in category 'as yet unclassified') ----- result "Perform the test the default number of times" ^ self resultFor: self class defaultRuns ! Item was changed: + ----- Method: RecentMessagesTest>>testIsEmpty (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testIsEmpty (in category 'testing') ----- testIsEmpty self assert: rm isEmpty description: 'Initially, must be empty'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self deny: rm isEmpty description: 'After submission, must not be empty'.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'testing') ----- testMaximumSubmissionCountCanReduceNumberOfReferences rm maximumSubmissionCount: 2. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. rm maximumSubmissionCount: 1. self assert: 1 equals: rm size.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'testing') ----- testMaximumSubmissionCountCapsReferenceCount rm maximumSubmissionCount: 2. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals. self assert: #bar equals: rm leastRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'testing') ----- testMaximumSubmissionCountDefaultsToTen self assert: 30 equals: rm maximumSubmissionCount.! Item was changed: + ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'testing') ----- testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions rm maximumSubmissionCount: 0. self assert: 0 equals: rm maximumSubmissionCount. rm maximumSubmissionCount: 1. self assert: 1 equals: rm maximumSubmissionCount.! Item was changed: + ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'testing') ----- testMethodReferencesReturnsAllSubmissions | expected | expected := { MethodReference class: Utilities selector: #bar environment: env. MethodReference class: Utilities selector: #foo environment: env }. rm recordSelector: #foo forClass: Utilities inEnvironment: env. rm recordSelector: #bar forClass: Utilities inEnvironment: env. self assert: expected equals: rm methodReferences! Item was changed: + ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'testing') ----- testMethodReferencesReturnsaCopy | expected original | rm recordSelector: #foo forClass: Utilities inEnvironment: env. original := rm methodReferences. expected := original copy. rm recordSelector: #bar forClass: Utilities inEnvironment: env. self assert: expected equals: original.! Item was changed: + ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'testing') ----- testMostRecentReturnsLastAddedReference | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'bar ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. self assert: #foo equals: rm mostRecent selector. rm recordSelector: #bar forClass: victim inEnvironment: env. self assert: #bar equals: rm mostRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'testing') ----- testMostRecentReturnsRemovedReference | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'bar ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm recordSelector: #bar forClass: victim inEnvironment: env. victim removeSelector: #bar. self assert: #bar equals: rm mostRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'testing') ----- testOldestReturnsOldestSubmission self assert: nil equals: rm leastRecent description: 'Return nil if no submissions yet'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: #foo equals: rm leastRecent selector. rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals. self assert: #foo equals: rm leastRecent selector.! Item was changed: + ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'testing') ----- testPurgeMissingMethodsKeepsComments rm recordSelector: #Comment forClass: Utilities inEnvironment: Smalltalk globals. self deny: rm isEmpty.! Item was changed: + ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'testing') ----- testReferencesAreUnique rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'After duplicate'.! Item was changed: + ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'testing') ----- testRevertMostRecentRemovesLatestVersion | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. victim compile: 'foo ^ 2'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm revertMostRecent. self assert: 1 equals: victim new foo description: 'Version not removed'.! Item was changed: + ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'testing') ----- testRevertMostRecentRemovesNewMethod | victim | victim := self createClass: #Victim. victim compile: 'foo ^ 1'. rm recordSelector: #foo forClass: victim inEnvironment: env. rm revertMostRecent. self deny: (victim includesSelector: #foo) description: 'Method not removed'.! Item was changed: + ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'testing') ----- testSizeReturnsNumberOfRecordedMethodSubmissions self assert: 0 equals: rm size description: 'Initial state'. rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'After 1 submission'. rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals. self assert: 2 equals: rm size description: 'After 2 submissions'.! Item was changed: + ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'tests') ----- - ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'testing') ----- testSubmissionClassControlsLogging WantsChangeSetLogging yes. rm recordSelector: #foo forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals. WantsChangeSetLogging no. rm recordSelector: #bar forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals. self assert: 1 equals: rm size description: 'Class asked for logging not to happen'.! Item was changed: + ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'tests') ----- - ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'testing') ----- testClassesSystemCategory "Find cases where classes have nil system categories. This test will tell you the classes. This is inspired by the proposed fix of a bug in release of 3.10.1 see Mantis #7070" | rejectClasses | rejectClasses := nil systemNavigation allClasses reject: [ :each | each category notNil ] . self assert: rejectClasses isEmpty description: ('Classes with nil system categories: {1}' format: {rejectClasses asCommaString}).! Item was changed: + ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'tests') ----- - ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'testing') ----- testMethodsWithUnboundGlobals | unbound | unbound := SystemNavigation default methodsWithUnboundGlobals. Smalltalk cleanOutUndeclared. self assert: unbound isEmpty description: 'Unbound: ', unbound asCommaString! Item was changed: + ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'tests') ----- - ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'testing') ----- testNoObsoleteClasses | obsoleteClasses | obsoleteClasses := self systemNavigation obsoleteClasses. self assert: obsoleteClasses isEmpty description: ('{1} {2} obsolete' format: { obsoleteClasses asCommaStringAnd. obsoleteClasses size = 1 ifTrue: [ 'is' ] ifFalse: [ 'are' ] }) ! Item was changed: + ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'tests') ----- - ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'testing') ----- testSqueakThemeFonts "Check whether the fonts installed in the active theme in the release are correct" "preference selector - font family name - font size" { #(standardDefaultTextFont 'Bitmap DejaVu Sans' 9). #(standardListFont 'Bitmap DejaVu Sans' 9). #(standardFlapFont 'Bitmap DejaVu Sans' 7). #(standardMenuFont 'Bitmap DejaVu Sans' 9). #(windowTitleFont 'Bitmap DejaVu Sans' 9). #(standardBalloonHelpFont 'Bitmap DejaVu Sans' 7). #(standardCodeFont 'Bitmap DejaVu Sans' 9). #(standardButtonFont 'Bitmap DejaVu Sans' 7) } do: [:triple | | font | font := Preferences perform: triple first. self assert: triple second equals: font familyName. self assert: triple third equals: font pointSize ] ! Item was changed: + ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'tests') ----- - ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'testing') ----- testSuperSubclassReferences "see mantis bug 7090 for more info on this" "If the reason for this test to fail is above bug, the following might fix the system" "(ProtoObject subclasses reject: [:each | each isMeta or: [each environment includes: each]]) do: [:each | ProtoObject removeSubclass: each]" | strangeClasses | strangeClasses := ProtoObject allSubclasses reject: [:each | each isMeta or: [each environment includes: each]]. self assert: strangeClasses isEmpty description: ('Not expecting to find any of {1}' format: {strangeClasses asCommaString}).! Item was changed: + ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'tests') ----- - ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'testing') ----- testSwapMouseButtonsPreference "Swap mouse buttons should be enabled" self assert: Preferences swapMouseButtons! Item was changed: + ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'tests') ----- - ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'testing') ----- testSystemCategoryClasses "Find cases where system categories name absent classes. This test will tell you the classes. This is inspired by a bug in release of 3.10.1 see Mantis #7070" | rejectCats rejectClasses | rejectCats := SystemOrganization categories reject: [ :catName | (SystemOrganization listAtCategoryNamed: catName) allSatisfy: [ :className | ( Smalltalk includesKey: className ) ] ] . "self assert: rejectCats isEmpty ." rejectCats isEmpty ifTrue: [ ^ true ] . rejectClasses := rejectCats collect: [ :each | each -> ( (SystemOrganization listAtCategoryNamed: each) reject: [ :eachOne | ( Smalltalk includesKey: eachOne ) ] ) ] . self assert: rejectCats isEmpty description: ('Not expecting any of {1}' format: { rejectClasses asCommaString}). ! Item was changed: + ----- Method: ReleaseTest>>testUndeclared (in category 'tests') ----- - ----- Method: ReleaseTest>>testUndeclared (in category 'testing') ----- testUndeclared Smalltalk cleanOutUndeclared. self assert: Undeclared isEmpty description: ('{1} {2} in Undeclared' format: { Undeclared keys asCommaStringAnd. Undeclared keys size = 1 ifTrue: [ 'is' ] ifFalse: [ 'are' ] })! Item was changed: + ----- Method: ScannerTest>>testLiteralSymbols (in category 'tests') ----- - ----- Method: ScannerTest>>testLiteralSymbols (in category 'testing') ----- testLiteralSymbols self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | Scanner isLiteralSymbol: (String with: char) asSymbol]) description: 'single letter binary symbols can be printed without string quotes'. self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | Scanner isLiteralSymbol: str asSymbol]) description: 'valid ascii selector symbols can be printed without string quotes'. ((32 to: 126) collect: [:ascii | Character value: ascii]) , #(':x:yourself' '::' 'x:yourself' '123' 'x0:1:2:' 'x.y.z' '1abc' 'a1b0c2' ' x' 'x ' '+x-y' '||' '--' '++' '+-' '+/-' '-/+' '<|>' '#x' '()' '[]' '{}' '') do: [:str | self assert: (Compiler evaluate: str asSymbol printString) = str asSymbol description: 'in all case, a Symbol must be printed in an interpretable fashion']! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'testing - examples') ----- testEmptyInput self assert: ((SecureHashAlgorithm new hashMessage: '') radix: 16) = 'DA39A3EE5E6B4B0D3255BFEF95601890AFD80709'! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'testing - examples') ----- testExample1 "This is the first example from the specification document (FIPS PUB 180-1)" hash := SecureHashAlgorithm new hashMessage: 'abc'. self assert: (hash = 16rA9993E364706816ABA3E25717850C26C9CD0D89D). ! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'testing - examples') ----- testExample2 "This is the second example from the specification document (FIPS PUB 180-1)" hash := SecureHashAlgorithm new hashMessage: 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'. self assert: (hash = 16r84983E441C3BD26EBAAE4AA1F95129E5E54670F1).! Item was changed: + ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'tests - examples') ----- - ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'testing - examples') ----- testExample3 "This is the third example from the specification document (FIPS PUB 180-1). This example may take several minutes." hash := SecureHashAlgorithm new hashMessage: (String new: 1000000 withAll: $a). self assert: (hash = 16r34AA973CD4C4DAA4F61EEB2BDBAD27316534016F).! Item was changed: + ----- Method: SumBugs>>testSummingColors (in category 'tests') ----- - ----- Method: SumBugs>>testSummingColors (in category 'as yet unclassified') ----- testSummingColors "self run: #testSummingColors" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. }. cases do: [ :each | self assert: ((Array with: each) sum = each) ]. ! Item was changed: + ----- Method: SumBugs>>testSummingToTen (in category 'tests') ----- - ----- Method: SumBugs>>testSummingToTen (in category 'as yet unclassified') ----- testSummingToTen "self run: #testSummingToTen" | cases | cases :={ { 1 . 2 . 3 . 4 }. { 2.0 . 2.0 . 2.0 . 2.0 . 2.0 }. { 2/5 . 5/2 . 5/2 . 3/5 . 4 } } . cases do: [ :each | self assert: (each sum = 10 ) ] .! Item was changed: + ----- Method: SumBugs>>testSummingToWhite (in category 'tests') ----- - ----- Method: SumBugs>>testSummingToWhite (in category 'as yet unclassified') ----- testSummingToWhite "self run: #testSummingToWhite" | cases | cases := { { Color black . Color white }. { Color red . Color green. Color blue }. { Color gray . Color gray }. { Color cyan. Color magenta. Color yellow }. { Color cyan. Color magenta. }. { Color magenta. Color yellow }. { Color cyan. Color yellow }. { Color cyan. Color red }. { Color green .Color magenta. }. { Color blue. Color yellow }. } . cases do: [ :each | self assert: (each sum = Color white) ] . ! Item was changed: + ----- Method: SumBugs>>testSummingWithBlack (in category 'tests') ----- - ----- Method: SumBugs>>testSummingWithBlack (in category 'as yet unclassified') ----- testSummingWithBlack "self run: #testSummingWithBlack" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. }. cases do: [ :each | self assert: ((Array with: each with: Color black) sum = each) ] . ! Item was changed: + ----- Method: SumBugs>>testSummingWithWhite (in category 'tests') ----- - ----- Method: SumBugs>>testSummingWithWhite (in category 'as yet unclassified') ----- testSummingWithWhite "self run: #testSummingWithWhite" | cases | cases := { Color black. Color red. Color green. Color blue. Color cyan. Color magenta. Color yellow. Color white. } . cases do: [ :each | self assert: ((Array with: Color white with: each ) sum = Color white) ] . ! Item was changed: + ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'tests') ----- - ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'as yet unclassified') ----- testMajorMinorVersion " SystemVersionTest run: #testMajorMinorVersion " self assert: (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion = 'Squeak3.7'. self assert: (SystemVersion new version: 'Squeak3.7') majorMinorVersion = 'Squeak3.7'. self assert: (SystemVersion new version: 'Squeak3') majorMinorVersion = 'Squeak3'. self assert: (SystemVersion new version: '') majorMinorVersion = ''. ! Item was changed: + ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'testing') ----- testAddNumbers self assert: (self add: 3 with: 4) = 7. self assert: (self perform: #add:with: withArguments: #(3 4)) = 7.! Item was changed: + ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'testing') ----- testAnswer42 self assert: self answer42 = 42! Item was changed: + ----- Method: TestObjectsAsMethods>>testDNU (in category 'tests') ----- - ----- Method: TestObjectsAsMethods>>testDNU (in category 'testing') ----- testDNU self should: [self foo] raise: MessageNotUnderstood! Item was changed: + ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'tests') ----- - ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'testing') ----- testVmStatisticsReportString "Results of this test vary by VM implementation. Failure usually indicates an unchecked assumption about the array size." self shouldnt: [Smalltalk vmStatisticsReportString] raise: Error description: 'probable unchecked VM statistics array size' ! Item was changed: + ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'private') ----- - ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'tests') ----- valueWithinNonLocalReturn "Do a non-local return from a valueWithin: block" [^self] valueWithin: 20 milliSeconds onTimeout:[]. !

1 0

The Trunk: Monticello-pre.691.mcz
by commits＠source.squeak.org 07 Dec '18

07 Dec '18

Patrick Rein uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-pre.691.mcz ==================== Summary ==================== Name: Monticello-pre.691 Author: pre Time: 7 December 2018, 1:22:45.743037 pm UUID: 2eb76786-f610-47aa-97fa-9a4d90f4894d Ancestors: Monticello-pre.690 Categorizes the methods of MCToolWindowBuilder as they were still missing. =============== Diff against Monticello-pre.690 =============== Item was changed: + ----- Method: MCToolWindowBuilder>>build (in category 'building') ----- - ----- Method: MCToolWindowBuilder>>build (in category 'as yet unclassified') ----- build ^ builder build: window! Item was changed: + ----- Method: MCToolWindowBuilder>>buttonRow (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>buttonRow (in category 'as yet unclassified') ----- buttonRow ^ self buttonRow: tool buttonSpecs! Item was changed: + ----- Method: MCToolWindowBuilder>>buttonRow: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>buttonRow: (in category 'as yet unclassified') ----- buttonRow: specArray | panel | panel := builder pluggablePanelSpec new. panel children: OrderedCollection new. specArray do: [:spec | | button | button := builder pluggableButtonSpec new. button model: tool. button label: spec first asString. button action: spec second. button help: spec third. button enabled: (spec at: 4 ifAbsent: [#buttonEnabled]). button state: (spec at: 5 ifAbsent: [#buttonSelected]). panel children add: button]. panel layout: #horizontal. panel frame: currentFrame. window children add: panel! Item was changed: + ----- Method: MCToolWindowBuilder>>codePane: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>codePane: (in category 'as yet unclassified') ----- codePane: aSymbol | text | text := builder pluggableCodePaneSpec new. text model: tool; getText: aSymbol; setText: (aSymbol, ':') asSymbol; frame: currentFrame. window children add: text! Item was changed: + ----- Method: MCToolWindowBuilder>>frame: (in category 'accessing') ----- - ----- Method: MCToolWindowBuilder>>frame: (in category 'as yet unclassified') ----- frame: aLayoutFrame currentFrame := aLayoutFrame! Item was changed: + ----- Method: MCToolWindowBuilder>>initializeWithBuilder:tool: (in category 'initialize-release') ----- - ----- Method: MCToolWindowBuilder>>initializeWithBuilder:tool: (in category 'as yet unclassified') ----- initializeWithBuilder: aBuilder tool: aTool builder := aBuilder. tool := aTool. window := builder pluggableWindowSpec new. window children: OrderedCollection new. window label: tool label asString. window model: tool. window extent: tool defaultExtent.! Item was changed: + ----- Method: MCToolWindowBuilder>>innerButtonRow (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>innerButtonRow (in category 'as yet unclassified') ----- innerButtonRow ^ self buttonRow: tool innerButtonSpecs! Item was changed: + ----- Method: MCToolWindowBuilder>>inputMorph: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>inputMorph: (in category 'as yet unclassified') ----- inputMorph: aSymbol | text | text := builder pluggableInputFieldSpec new. text model: tool; getText: aSymbol; setText: (aSymbol, ':') asSymbol; frame: currentFrame. window children add: text! Item was changed: + ----- Method: MCToolWindowBuilder>>listMorph: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>listMorph: (in category 'as yet unclassified') ----- listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol! Item was changed: + ----- Method: MCToolWindowBuilder>>listMorph:keystroke: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>listMorph:keystroke: (in category 'as yet unclassified') ----- listMorph: listSymbol keystroke: keystrokeSymbol ^ (self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol menu: (listSymbol, 'ListMenu:') asSymbol) keystrokeActionSelector: keystrokeSymbol; yourself! Item was changed: + ----- Method: MCToolWindowBuilder>>listMorph:selection: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>listMorph:selection: (in category 'as yet unclassified') ----- listMorph: listSymbol selection: selectionSymbol self listMorph: listSymbol selection: selectionSymbol menu: nil! Item was changed: + ----- Method: MCToolWindowBuilder>>listMorph:selection:menu: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>listMorph:selection:menu: (in category 'as yet unclassified') ----- listMorph: listSymbol selection: selectionSymbol menu: menuSymbol self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil! Item was changed: + ----- Method: MCToolWindowBuilder>>listMorph:selection:menu:keystroke: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>listMorph:selection:menu:keystroke: (in category 'as yet unclassified') ----- listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol | list | list := builder pluggableListSpec new. list model: tool; list: listSymbol; getIndex: selectionSymbol; setIndex: (selectionSymbol, ':') asSymbol; frame: currentFrame. menuSymbol ifNotNil: [list menu: menuSymbol]. keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. window children add: list ! Item was changed: + ----- Method: MCToolWindowBuilder>>multiListMorph:selection:listSelection:menu: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>multiListMorph:selection:listSelection:menu: (in category 'as yet unclassified') ----- multiListMorph: listSymbol selection: selectionSymbol listSelection: listSelectionSymbol menu: menuSymbol | list | list := builder pluggableMultiSelectionListSpec new. list model: tool; list: listSymbol; getIndex: selectionSymbol; setIndex: (selectionSymbol, ':') asSymbol; getSelectionList: listSelectionSymbol; setSelectionList: (listSelectionSymbol, 'put:') asSymbol; frame: currentFrame. menuSymbol ifNotNil: [list menu: menuSymbol]. window children add: list ! Item was changed: + ----- Method: MCToolWindowBuilder>>textMorph: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>textMorph: (in category 'as yet unclassified') ----- textMorph: aSymbol | text | text := builder pluggableTextSpec new. text model: tool; getText: aSymbol; setText: (aSymbol, ':') asSymbol; frame: currentFrame. window children add: text! Item was changed: + ----- Method: MCToolWindowBuilder>>treeMorph: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>treeMorph: (in category 'as yet unclassified') ----- treeMorph: listSymbol ^ self treeMorph: (listSymbol, 'Tree') asSymbol selection: (listSymbol, 'SelectionWrapper') asSymbol menu: (listSymbol, 'TreeMenu:') asSymbol! Item was changed: + ----- Method: MCToolWindowBuilder>>treeMorph:selection:menu: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>treeMorph:selection:menu: (in category 'as yet unclassified') ----- treeMorph: listSymbol selection: selectionSymbol menu: menuSymbol self notYetImplemented! Item was changed: + ----- Method: MCToolWindowBuilder>>treeOrListMorph: (in category 'building-parts') ----- - ----- Method: MCToolWindowBuilder>>treeOrListMorph: (in category 'as yet unclassified') ----- treeOrListMorph: listSymbol ^ self listMorph: listSymbol!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2018